重画系列:DatagridColumnStyle-CSDN博客

本文链接：https://blog.csdn.net/ganenpingsohucom/article/details/20012

效果图如下：

源代码如下:

'*********************************************************************************************************************************************
    '重画DataGrid列样式，显示网站类型，链接
    '*********************************************************************************************************************************************
    Public Class FiveColumn_Style2
        Inherits DataGridColumnStyle

        Private xMargin As Integer = 2
        Private yMargin As Integer = 2
        Private CurrentRow As Integer = -1 '用于datagrid_mousemove事件中，引起label的更新
        ''''''''''''需要的控件
        Private WithEvents m_Label As LinkLabel '显示链接
        'Private WithEvents Pic_Favorite As PictureBox '显示是否加入过收藏夹
        'Private WithEvents Pic_State As PictureBox   '显示是否打得开
        Private WithEvents Pic_Analize As PictureBox
        ''''''''''''需要的图片
        Private Image_Favorite_true As Image
        Private Image_Favorite_false As Image
        Private Image_State_true As Image
        Private Image_State_false As Image
        Private Image_State_unknow As Image
        Private Image_Analize_true As Image
        Private Image_Analize_false As Image

        Public WriteOnly Property SetPath_Favorite_true() As String
            Set(ByVal Path As String)
                ''读取图片
                Image_Favorite_true = Image.FromFile(Path)
            End Set
        End Property
        Public WriteOnly Property SetPath_Favorite_false() As String
            Set(ByVal Path As String)
                Image_Favorite_false = Image.FromFile(Path)
            End Set
        End Property
        Public WriteOnly Property SetPath_State_true() As String
            Set(ByVal Value As String)
                Image_State_true = Image.FromFile(Value)
            End Set
        End Property
        Public WriteOnly Property SetPath_State_false() As String
            Set(ByVal Value As String)
                Image_State_false = Image.FromFile(Value)
            End Set
        End Property
        Public WriteOnly Property SetPath_State_unknow() As String
            Set(ByVal Value As String)
                Image_State_unknow = Image.FromFile(Value)
            End Set
        End Property
        Public WriteOnly Property SetPath_Analize_true() As String
            Set(ByVal Value As String)
                Image_Analize_true = Image.FromFile(Value)
            End Set
        End Property
        Public WriteOnly Property SetPath_Analize_false() As String
            Set(ByVal Value As String)
                Image_Analize_false = Image.FromFile(Value)
            End Set
        End Property
        '需要的文本提示
        Private ServerToolTip As ToolTip '显示服务器信息
        Private TopicToolTip As ToolTip   '摘要信息
        'Private ContentToolTip As ToolTip '内容信息
        '提示文本
        Private m_tipstr As String = ""
        Private WithEvents m_datagrid As DataGrid
        'Private m_CurrentRow As Integer = -1 '用于datagrid_mouseup事件中，引起选中行后变色
        Private ImagePath As String = Application.StartupPath
        '显示结果分析
        Private WithEvents m_tootip As Form2
        '设置当前用户点击时Datagird的current
        Private Sub SetCurrentRowNum(ByVal Value As Integer)
            Me.CurrentRow = Value
            If Me.CurrentRow < 0 Then
                m_Label.Visible = False
                Me.Pic_Analize.Visible = False
            End If
        End Sub

        '初始化
        Sub New()
            Me.CurrentRow = -1
            m_Label = New LinkLabel()
            m_Label.Font = New Font("宋体", 9, FontStyle.Regular)
            m_Label.Text = ""
            m_Label.Visible = False
            m_Label.TextAlign = ContentAlignment.TopLeft
            m_Label.Height = 10
            Me.Pic_Analize = New PictureBox()
            Pic_Analize.SizeMode = PictureBoxSizeMode.StretchImage
            Pic_Analize.Cursor = Cursors.Hand
            Pic_Analize.Size = Me.imagesize
            Me.Pic_Analize.Visible = False

ServerToolTip = New ToolTip()
TopicToolTip = New ToolTip()

            'm_tootip = New Form2()
        End Sub
        '当点击了链节后，打开url
        Private Sub Label_LinkClicked(ByVal sender As Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles m_Label.LinkClicked
            Dim myproc As System.Diagnostics.Process
            myproc = New System.Diagnostics.Process()
            myproc.Start("IExplore.exe", m_Label.Tag)
        End Sub
        '------------------------------------------------------
        '从 DataGridColumnStyle类继承下来的方法
        '------------------------------------------------------
        Protected Overloads Overrides Sub Abort(ByVal RowNum As Integer)
        End Sub
        ' 接受改变
        Protected Overloads Overrides Function Commit(ByVal DataSource As CurrencyManager, _
                                          ByVal RowNum As Integer) As Boolean
        End Function
        ' 移开聚焦
        Protected Overloads Overrides Sub ConcedeFocus()
        End Sub
        ' 编辑单元格
        Protected Overloads Overrides Sub Edit(ByVal Source As CurrencyManager, _
                                               ByVal Rownum As Integer, _
                                               ByVal Bounds As Rectangle, _
                                               ByVal [ReadOnly] As Boolean, _
                                               ByVal InstantText As String, _
                                               ByVal CellIsVisible As Boolean)
        End Sub

Protected Overloads Overrides Function GetMinimumHeight() As Integer

        End Function
        Protected Overloads Overrides Function GetPreferredHeight(ByVal g As Graphics, _
                                             ByVal Value As Object) As Integer
            Dim NewLineIndex As Integer = 0
            Dim NewLines As Integer = 0
            Try

                Dim ValueString As String = Me.GetText(Value)
                Do
                    While NewLineIndex <> -1
                        NewLineIndex = ValueString.IndexOf("r/n", NewLineIndex + 1)
                        NewLines += 1
                    End While
                Loop
            Catch es As Exception
            End Try
            Return FontHeight * NewLines + yMargin
        End Function
        Protected Overloads Overrides Function GetPreferredSize(ByVal g As Graphics, _
                                                    ByVal Value As Object) As Size
            Dim Extents As Size
            Try
                Extents = System.Drawing.Size.Ceiling(g.MeasureString(GetText(Value), _
                                            Me.DataGridTableStyle.DataGrid.Font))
                Extents.Width += xMargin * 2 + DataGridTableGridLineWidth
                Extents.Height += yMargin
            Catch es As Exception
            End Try
            Return Extents
        End Function
        Protected Overloads Overrides Sub Paint(ByVal g As Graphics, _
                                                ByVal Bounds As Rectangle, _
                                                ByVal Source As CurrencyManager, _
                                                ByVal RowNum As Integer)
            Paint(g, Bounds, Source, RowNum, False)
        End Sub
        '和单元格底部的距离
        Private Const botton As Integer = 2
        '三个小图标的间隔
        Private Const intnear As Integer = 3
        '图像的大小
        Private imagesize As New Size(13, 13)
        '文本分几行显示
        Private Const RowDisplay As Integer = 3
        '对文本分行
        Private Function TextMuiltilize(ByVal str As String, ByRef g As Graphics) As String
            If g Is Nothing Then Exit Function
            If str = "" Then Exit Function
            Dim newstr As String
            Dim tmpStr As String
            ' assume we are using same fonts
            Dim font As System.Drawing.Font = New Font("宋体", 9)
            Dim i As Integer = 0
            ' we want to measure the width of string byte by byte in case we found
            ' double bytes characters. If we find it has reached the right bounds, we
            ' append a line break
            Do While str.Length > 0
                Do
                    If str.Length <= 0 Then
                        Exit Do
                    End If
                    If g.MeasureString(tmpStr & Left(str, 1), font).Width >= (Me.Width - 1) Then
                        Exit Do
                    End If
                    tmpStr = tmpStr & Left(str, 1)
                    str = str.Substring(1)
                Loop
                If newstr = "" Then
                    newstr = tmpStr
                Else
                    newstr = newstr & vbCrLf & tmpStr
                End If
                i = i + 1
                If i >= RowDisplay Then
                    'if there is a fouth line, we move two characters away and put ...
                    If str.Length > 0 Then
                        str = Right(tmpStr, 2) & str
                        newstr = Left(newstr, Len(newstr) - 3) & "..."
                    End If
                    Exit Do
                End If
                tmpStr = ""
            Loop
            Return newstr
        End Function

        Private Structure Range_Str
            Public Range As CharacterRange
            Public Str As String
        End Structure
        '关键字变色
        Private Sub PaintKeyWord(ByVal newStr As String, ByVal keyword As String, ByVal Bounds As Rectangle, ByVal RowNum As Integer, ByVal dbrush As Brush, ByRef g As Graphics)
            If newStr = "" Then Exit Sub
            Try
                '保存charactarrange和其中的字符
                Dim CharRangeList As ArrayList = CreatCRange(newStr, keyword)
                Dim i As Integer
                Dim count As Integer
                If CharRangeList.Count > 32 Then
                    count = 32
                Else
                    count = CharRangeList.Count
                End If
                '把arraylist中的Range赋予array
                Dim CRangeArray(count - 1) As CharacterRange
                For i = 0 To count - 1
                    CRangeArray(i) = CType(CharRangeList(i), Range_Str).Range
                Next
                '字符串格式
                Dim stringFormat As New StringFormat
                stringFormat.SetMeasurableCharacterRanges(CRangeArray)
                stringFormat.Alignment = StringAlignment.Near
                stringFormat.LineAlignment = StringAlignment.Near
                'stringFormat.FormatFlags = StringFormatFlags.MeasureTrailingSpaces

                '定义字体
                Dim font As System.Drawing.Font = New Font("宋体", 9)
                '取得newstr的大小
                Dim newstrsize As SizeF = g.MeasureString(newStr, font)
                '取得newstr所在的bounds
                Dim boundsf As New RectangleF(Bounds.X + xMargin, Bounds.Y + yMargin, newstrsize.Width, newstrsize.Height)
                '通过此方法生成关于各个CharacterRange在bounds上的Region
                Dim stringRegions() As Region = g.MeasureCharacterRanges(newStr, font, boundsf, stringFormat)
                '根据每个相关关键字字符串的bounds,画成红色
                For i = 0 To stringRegions.Length - 1
                    Dim measureRect As RectangleF = stringRegions(i).GetBounds(g)
                    Dim m_size As SizeF = g.MeasureString(CType(CharRangeList(i), Range_Str).Str, font)
                    Dim MymeasureRect As New RectangleF(measureRect.X - 1, measureRect.Y, m_size.Width - m_size.Width * 30 / 100, m_size.Height - m_size.Height * 20 / 100)
                    If Me.m_datagrid.CurrentRowIndex = RowNum Then
                        g.FillRectangle(dbrush, MymeasureRect)
                    Else
                        g.FillRectangle(Brushes.White, MymeasureRect)
                    End If
                    g.DrawString(CType(CharRangeList(i), Range_Str).Str, font, Brushes.Red, MymeasureRect.X - xMargin, MymeasureRect.Y)
                Next
            Catch e As System.Exception
                Trace.WriteLine("ERROR AT KEYWORD RED " & e.ToString)
            End Try
        End Sub
        Private Function CreatCRange(ByVal OriStr As String, ByVal Keyword As String) As ArrayList

            Dim myRangeArray As New ArrayList()
            If OriStr = "" Then
                Return myRangeArray
            End If
            '扫描文本，看其每一字符是否存在于关键在中间,if exit then add Range_Str structure into arraylist to return
            Dim i As Integer
            For i = 0 To OriStr.Length - 1
                If Keyword.ToLower.IndexOf(OriStr.Chars(i).ToString.ToLower) >= 0 Then
                    Dim R_S As New Range_Str()
                    R_S.Range = New CharacterRange(i, 1)
                    R_S.Str = OriStr.Chars(i)
                    myRangeArray.Add(R_S)
                End If
            Next
            Return myRangeArray
        End Function
        'url与三个图标之间的间隔
        Private Const UrlNear As Integer = 35
        Private Const AnalizeNum As Integer = 5
        '重画的主要函数
        Protected Overloads Overrides Sub Paint(ByVal g As Graphics, _
                                                ByVal Bounds As Rectangle, _
                                                ByVal Source As CurrencyManager, _
                                                ByVal RowNum As Integer, _
                                                ByVal AlignToRight As Boolean)
            '画背景
            Dim dbrush As Brush = New SolidBrush(System.Drawing.Color.FromArgb(CType(230, Byte), CType(236, Byte), CType(238, Byte)))
            Dim m_CurrentRow As Integer = Me.m_datagrid.CurrentRowIndex
            If m_CurrentRow = RowNum Then
                g.FillRectangle(dbrush, Bounds)
            Else
                g.FillRectangle(Brushes.White, Bounds)
            End If
            '定义字体
            Dim font As System.Drawing.Font = New Font("宋体", 9)
            '得到绑定的文本并区分
            Dim Text As String = GetText(GetColumnValueAtRow(Source, RowNum)).Replace(vbLf, "")
            Dim str() As String = Microsoft.VisualBasic.Split(Text, "$@")
            'title和url必须有
            Dim keyword As String = str(0).Trim ' 关键字
            Dim Url As String      '链接
            If str.Length > 1 Then
                Url = str(1).Trim
            End If
            Dim Content As String   '内容
            If str.Length > 2 Then
                Content = str(2).Trim
            End If
            Dim State As Integer = 0
            Dim Server As String = ""
            Dim Modifed As String = ""
            Dim AnalizeInfo As String = ""
            Dim BoolFavorite As Integer = 0
            '对可能存在的文本赋值
            If str.Length > 3 Then
                If Char.IsDigit(str(3).Trim) Then
                    State = str(3).Trim
                Else
                    State = 0
                End If
            End If
            If str.Length > 4 Then
                Server = str(4).Trim
            End If
            If str.Length > 5 Then
                Modifed = str(5).Trim
            End If
            If str.Length > 6 Then
                AnalizeInfo = str(6).Trim
            End If
            If str.Length > 7 Then
                If str(7).Trim = "" Then
                    BoolFavorite = 0
                Else
                    BoolFavorite = str(7).Trim
                End If
            End If
            '计算url的大小
            Dim TextSize As SizeF = g.MeasureString(Url, New Font("宋体", 9))
            '设置各自的位置
            ''url
            Dim point_url As New Point(Bounds.X + Me.xMargin, Bounds.Y + Bounds.Height - Me.botton - TextSize.Height)
            ''content
            Dim point_content As New Point(Bounds.X + Me.xMargin, Bounds.Y + Me.yMargin)
            ''Favorite
            Dim point_favorite As New Point(Bounds.X + Bounds.Width - 3 * (intnear + imagesize.Width), Bounds.Y + Bounds.Height - imagesize.Height - Me.botton)
            '’State
            Dim point_state As New Point(Bounds.X + Bounds.Width - 2 * (intnear + imagesize.Width), Bounds.Y + Bounds.Height - imagesize.Height - Me.botton)
            ''Analize
            Dim point_analize As New Point(Bounds.X + Bounds.Width - (intnear + imagesize.Width), Bounds.Y + Bounds.Height - imagesize.Height - Me.botton)
            Dim newstr As String = TextMuiltilize(Content, g)
            '画内容
            g.DrawString(newstr, font, Brushes.Black, Bounds.X + Me.xMargin, Bounds.Y + Me.yMargin)
            '画关键字
            Me.PaintKeyWord(newstr, keyword, Bounds, RowNum, dbrush, g)
            '当不是选中行时，画image
            Dim lineFont As New Font("宋体", 9, FontStyle.Underline)
            '画url
            '如果url太长了
            Dim NewUrl As String
            Dim Url_Width As Integer = (Me.Width - 3 * (Me.intnear + Me.imagesize.Width) - UrlNear)
            If g.MeasureString(Url, font).Width > Url_Width Then
                Dim layoutSize As New SizeF(Url_Width, TextSize.Height)
                Dim newStringFormat As New StringFormat()
                ' Measure string.
                '取得bounds内的字符个数
                Dim charactersFitted As Integer
                '取得bounds内的字符行数
                Dim linesFilled As Integer
                Dim stringSize As SizeF = g.MeasureString(Url, font, layoutSize, newStringFormat, charactersFitted, linesFilled)
                NewUrl = Url.Substring(0, charactersFitted) & "..."
            Else
                NewUrl = Url
            End If
            Dim url_format As New StringFormat()
            url_format.HotkeyPrefix = Drawing.Text.HotkeyPrefix.Show
            g.DrawString(NewUrl, lineFont, Brushes.Blue, point_url.X, point_url.Y, url_format)

'画结果分析

            If AnalizeInfo.Length > AnalizeNum Then
                '    g.DrawImage(Me.Image_Analize_false, point_analize.X, point_analize.Y, imagesize.Width, imagesize.Height)
                'Else
                g.DrawImage(Me.Image_Analize_true, point_analize.X, point_analize.Y, imagesize.Width, imagesize.Height)
            End If

            '画state
            If State = 0 Then
                g.DrawImage(Me.Image_State_false, point_state.X, point_state.Y, imagesize.Width, imagesize.Height)
            ElseIf State = 1 Then
                g.DrawImage(Me.Image_State_true, point_state.X, point_state.Y, imagesize.Width, imagesize.Height)
            Else
                g.DrawImage(Me.Image_State_unknow, point_state.X, point_state.Y, imagesize.Width, imagesize.Height)
            End If

            '画favorite
            If BoolFavorite = 0 Then
                'g.DrawImage(Me.Image_Favorite_false, point_favorite.X, point_favorite.Y, imagesize.Width, imagesize.Height)
            Else
                g.DrawImage(Me.Image_Favorite_true, point_favorite.X, point_favorite.Y, imagesize.Width, imagesize.Height)
            End If
            '如果此行为当前行，需要显示linklabel,和三个picturebox
            If CurrentRow = RowNum Then

                '如果是选中行，需要改变背景色
                If m_CurrentRow = RowNum Then
                    m_Label.BackColor = System.Drawing.Color.FromArgb(CType(230, Byte), CType(236, Byte), CType(238, Byte))
                Else
                    m_Label.BackColor = Color.White
                End If
                '
                '为linklabel设置bounds
                m_Label.Tag = Url
                m_Label.Text = NewUrl
                '设置label显示的位置和大小
                Dim UrlSize As SizeF = g.MeasureString(NewUrl, New Font("宋体", 9))
                m_Label.SetBounds(point_url.X, point_url.Y, UrlSize.Width + 2, UrlSize.Height)
                m_Label.Visible = True
                ''设置能否打开picture控件的bounds
                '''打不开
                If State = 0 Then
                    ServerToolTip.RemoveAll()
                Else
                    Me.m_tipstr = "服务器类型：" & Server & vbCrLf & "最后更新时间：" & Modifed
                    ServerToolTip.SetToolTip(m_Label, Me.m_tipstr)
                End If

                '设置结果分析picturebox的bounds
                '没有结果
                '如果没有做页面分析则不显示图片
                If AnalizeInfo.Length > AnalizeNum Then
                    Me.Pic_Analize.Image = Me.Image_Analize_true
                    Me.Pic_Analize.Enabled = True
                    Me.Pic_Analize.Tag = AnalizeInfo
                    Me.m_tipstr = "查看摘要"
                    TopicToolTip.SetToolTip(Pic_Analize, Me.m_tipstr)
                    Me.Pic_Analize.Visible = True
                Else
                    Me.Pic_Analize.Visible = False
                End If
                Me.Pic_Analize.SetBounds(point_analize.X, point_analize.Y, imagesize.Width, imagesize.Height)
            End If
            '如果label所在位置不是当前行，就不要显示label
            If m_datagrid.HitTest(m_Label.Location).Row <> CurrentRow Then
                m_Label.Visible = False
                Me.Pic_Analize.Visible = False
            End If

        End Sub
        Protected Overloads Sub Paint(ByVal g As Graphics, _
                                      ByVal Bounds As Rectangle, _
                                      ByVal Source As CurrencyManager, _
                                      ByVal RowNum As Integer, _
                                      ByVal BackBrush As Brush, _
                                      ByVal ForeBrush As Brush, _
                                      ByVal AlignToRight As Boolean)

Paint(g, Bounds, Source, RowNum, False)
End Sub

        Protected Overloads Overrides Sub SetDataGridInColumn(ByVal Value As DataGrid)
            MyBase.SetDataGridInColumn(Value)
            '加入linklabel作为datagrid的子控件
            Value.Controls.Add(m_Label)
            Value.Controls.Add(Me.Pic_Analize)
            'Value.Controls.Add(Me.Pic_State)
            '引用datagrid
            Me.m_datagrid = Value
        End Sub
        Protected Overloads Overrides Sub UpdateUI(ByVal Source As CurrencyManager, _
                                  ByVal RowNum As Integer, ByVal InstantText As String)
        End Sub
        Private ReadOnly Property DataGridTableGridLineWidth() As Integer
            Get
                If Me.DataGridTableStyle.GridLineStyle = DataGridLineStyle.Solid Then
                    Return 1
                Else
                    Return 0
                End If
            End Get
        End Property
        '得到绑定的数据源的某列的某行的文本
        Private Function GetText(ByVal Value As Object) As String
            If Value Is System.DBNull.Value Then Return NullText
            If Not Value Is Nothing Then
                Return Value.ToString
            Else
                Return String.Empty
            End If
        End Function
        '纪录前次的行值
        Private oldrownum As Integer = -1
        '在mousemove事件中引发当前行的paint，和old行的paint
        Private Sub m_datagrid_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles m_datagrid.MouseMove
            '如果激活的窗体不是住窗体，不要动
            If Not (Form.ActiveForm Is m_datagrid.FindForm) Then
                Exit Sub
            End If
            '得到鼠标位置的row和column值
            Dim hittest As DataGrid.HitTestInfo = m_datagrid.HitTest(m_datagrid.PointToClient(m_datagrid.MousePosition))
            '设置当前行
            Me.SetCurrentRowNum(hittest.Row)
        End Sub

        '当点击在label上时，也需要变色
        Private Sub Label_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles m_Label.MouseDown, Pic_Analize.MouseDown
            Dim hittest As DataGrid.HitTestInfo = m_datagrid.HitTest(m_datagrid.PointToClient(m_datagrid.MousePosition))
            If hittest.Row >= 0 Then
                Me.m_datagrid.CurrentRowIndex = hittest.Row
            End If
            '刷新整个grid，---------------------保留，可以改成刷新单元格
            m_datagrid.Refresh()
        End Sub

        Private Sub m_datagrid_DataSourceChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles m_datagrid.DataSourceChanged
            m_Label.Visible = False
            Me.Pic_Analize.Visible = False
        End Sub

        Private Sub m_tootip_Deactivate(ByVal sender As Object, ByVal e As System.EventArgs) Handles m_tootip.Deactivate
            If Not (m_tootip.IsDisposed) Then
                m_tootip.Close()
            End If
            Me.m_Label.FindForm.Activate()
            m_datagrid.Focus()
        End Sub

        Private Sub FiveColumn_Style2_WidthChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.WidthChanged
            Me.m_Label.Visible = False
            Me.Pic_Analize.Visible = False
        End Sub

        Private Sub Pic_Analize_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles Pic_Analize.MouseEnter
            If IsNothing(m_tootip) Then
            ElseIf m_tootip.IsDisposed Then
            Else
                Exit Sub
            End If
            m_tootip = New Form2()
            Dim PicLocate As Point = New Point(m_datagrid.MousePosition.X + Pic_Analize.Width, m_datagrid.MousePosition.Y + Pic_Analize.Height)
            m_tootip.Location = New Point(PicLocate.X - m_tootip.Width, PicLocate.Y - m_tootip.Height)
            m_tootip.SetText = Pic_Analize.Tag
            m_tootip.Show()
            AddHandler m_tootip.PctBack.MouseLeave, AddressOf m_tootip_MouseLeave
        End Sub

        Private Sub m_tootip_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) 'Handles m_tootip.MouseLeave
            Dim rect As Rectangle = (New Rectangle(m_tootip.Location, m_tootip.Size))
            If rect.Contains(m_datagrid.MousePosition) Then
                'donothing
            Else
                If Not (m_tootip.IsDisposed) Then

                    m_tootip.Close()
                End If
            End If
            Me.m_Label.FindForm.Activate()
            m_datagrid.Focus()
        End Sub

End Class

随后有测试程序代码。。。