Link to home
Start Free TrialLog in
Avatar of cobolinx1
cobolinx1

asked on

Richtextbox in datagridview

I get an error when trying to edit the richtextbox in a datagrid can someone help on how to resolve it.


        Protected Overloads Overrides Sub OnMouseClick(ByVal e As DataGridViewCellMouseEventArgs)
            MyBase.OnMouseClick(e)
            If MyBase.DataGridView IsNot Nothing Then
                Dim currentCellAddress As Point = MyBase.DataGridView.CurrentCellAddress

                If ((currentCellAddress.X = e.ColumnIndex) AndAlso (currentCellAddress.Y = e.RowIndex)) AndAlso (e.Button = MouseButtons.Left) Then
                    If (Me.flagsState And 1) <> 0 Then
                        Me.flagsState = CByte((Me.flagsState And -2))
                    ElseIf MyBase.DataGridView.EditMode <> DataGridViewEditMode.EditProgrammatically Then
                        MyBase.DataGridView.BeginEdit(False)   ''''   it happens here
                    End If
                End If
            End If
        End Sub
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Windows.Forms
Imports System.Drawing
Imports System.IO
Imports System.ComponentModel

Namespace DataGridViewRichTextBox
    Public Class DataGridViewRichTextBoxColumn
        Inherits DataGridViewColumn
        Public Sub New()
            MyBase.New(New DataGridViewRichTextBoxCell())
        End Sub

        Public Overloads Overrides Property CellTemplate() As DataGridViewCell
            Get
                Return MyBase.CellTemplate
            End Get
            Set(ByVal value As DataGridViewCell)
                If Not (TypeOf value Is DataGridViewRichTextBoxCell) Then
                    Throw New InvalidCastException("CellTemplate must be a DataGridViewRichTextBoxCell")
                End If

                MyBase.CellTemplate = value
            End Set
        End Property
    End Class

    Public Class DataGridViewRichTextBoxCell
        Inherits DataGridViewImageCell
        Private Shared ReadOnly _editingControl As New RichTextBox()

        Public Overloads Overrides ReadOnly Property EditType() As Type
            Get
                Return GetType(DataGridViewRichTextBoxEditingControl)
            End Get
        End Property

        Public Overloads Overrides Property ValueType() As Type
            Get
                Return GetType(String)
            End Get
            Set(ByVal value As Type)
                MyBase.ValueType = value
            End Set
        End Property

        Public Overloads Overrides ReadOnly Property FormattedValueType() As Type
            Get
                Return GetType(String)
            End Get
        End Property

        Private Shared Sub SetRichTextBoxText(ByVal ctl As RichTextBox, ByVal text As String)
            Try
                ctl.Rtf = text
            Catch generatedExceptionName As ArgumentException
                ctl.Text = text
            End Try
        End Sub

        Private Function GetRtfImage(ByVal rowIndex As Integer, ByVal value As Object, ByVal selected As Boolean) As Image
            Dim cellSize As Size = GetSize(rowIndex)

            If cellSize.Width < 1 OrElse cellSize.Height < 1 Then
                Return Nothing
            End If

            Dim ctl As RichTextBox = Nothing

            If ctl Is Nothing Then
                ctl = _editingControl
                ctl.Size = GetSize(rowIndex)
                SetRichTextBoxText(ctl, Convert.ToString(value))
            End If

            If ctl IsNot Nothing Then
                ' Print the content of RichTextBox to an image. 
                Dim imgSize As New Size(cellSize.Width - 1, cellSize.Height - 1)
                Dim rtfImg As Image = Nothing

                If selected Then
                    ' Selected cell state 
                    ctl.BackColor = DataGridView.DefaultCellStyle.SelectionBackColor
                    ctl.ForeColor = DataGridView.DefaultCellStyle.SelectionForeColor

                    ' Print image 
                    rtfImg = RichTextBoxPrinter.Print(ctl, imgSize.Width, imgSize.Height)

                    ' Restore RichTextBox 
                    ctl.BackColor = DataGridView.DefaultCellStyle.BackColor
                    ctl.ForeColor = DataGridView.DefaultCellStyle.ForeColor
                Else
                    rtfImg = RichTextBoxPrinter.Print(ctl, imgSize.Width, imgSize.Height)
                End If

                Return rtfImg
            End If

            Return Nothing
        End Function

        Public Overloads Overrides Sub InitializeEditingControl(ByVal rowIndex As Integer, ByVal initialFormattedValue As Object, ByVal dataGridViewCellStyle As DataGridViewCellStyle)
            MyBase.InitializeEditingControl(rowIndex, initialFormattedValue, dataGridViewCellStyle)

            Dim ctl As RichTextBox = TryCast(DataGridView.EditingControl, RichTextBox)

            If ctl IsNot Nothing Then
                SetRichTextBoxText(ctl, Convert.ToString(initialFormattedValue))
            End If
        End Sub

        Protected Overloads Overrides Function GetFormattedValue(ByVal value As Object, ByVal rowIndex As Integer, ByRef cellStyle As DataGridViewCellStyle, ByVal valueTypeConverter As TypeConverter, ByVal formattedValueTypeConverter As TypeConverter, ByVal context As DataGridViewDataErrorContexts) As Object
            Return value
        End Function

        Protected Overloads Overrides Sub Paint(ByVal graphics As Graphics, ByVal clipBounds As Rectangle, ByVal cellBounds As Rectangle, ByVal rowIndex As Integer, ByVal cellState As DataGridViewElementStates, ByVal value As Object, _
        ByVal formattedValue As Object, ByVal errorText As String, ByVal cellStyle As DataGridViewCellStyle, ByVal advancedBorderStyle As DataGridViewAdvancedBorderStyle, ByVal paintParts As DataGridViewPaintParts)
            MyBase.Paint(graphics, clipBounds, cellBounds, rowIndex, cellState, Nothing, _
            Nothing, errorText, cellStyle, advancedBorderStyle, paintParts)

            Dim img As Image = GetRtfImage(rowIndex, value, MyBase.Selected)

            If img IsNot Nothing Then
                graphics.DrawImage(img, cellBounds.Left, cellBounds.Top)
            End If
        End Sub

#Region "Handlers of edit events, copyied from DataGridViewTextBoxCell"

        Private flagsState As Byte

        Protected Overloads Overrides Sub OnEnter(ByVal rowIndex As Integer, ByVal throughMouseClick As Boolean)
            MyBase.OnEnter(rowIndex, throughMouseClick)

            If (MyBase.DataGridView IsNot Nothing) AndAlso throughMouseClick Then
                Me.flagsState = CByte((Me.flagsState Or 1))
            End If
        End Sub

        Protected Overloads Overrides Sub OnLeave(ByVal rowIndex As Integer, ByVal throughMouseClick As Boolean)
            MyBase.OnLeave(rowIndex, throughMouseClick)

            If MyBase.DataGridView IsNot Nothing Then
                Me.flagsState = CByte((Me.flagsState And -2))
            End If
        End Sub

        Protected Overloads Overrides Sub OnMouseClick(ByVal e As DataGridViewCellMouseEventArgs)
            MyBase.OnMouseClick(e)
            If MyBase.DataGridView IsNot Nothing Then
                Dim currentCellAddress As Point = MyBase.DataGridView.CurrentCellAddress

                If ((currentCellAddress.X = e.ColumnIndex) AndAlso (currentCellAddress.Y = e.RowIndex)) AndAlso (e.Button = MouseButtons.Left) Then
                    If (Me.flagsState And 1) <> 0 Then
                        Me.flagsState = CByte((Me.flagsState And -2))
                    ElseIf MyBase.DataGridView.EditMode <> DataGridViewEditMode.EditProgrammatically Then
                        MyBase.DataGridView.BeginEdit(False)
                    End If
                End If
            End If
        End Sub

        Public Overloads Overrides Function KeyEntersEditMode(ByVal e As KeyEventArgs) As Boolean
            Return (((((Char.IsLetterOrDigit(CChar(Microsoft.VisualBasic.ChrW(e.KeyCode))) AndAlso ((e.KeyCode < Keys.F1) OrElse (e.KeyCode > Keys.F24))) OrElse ((e.KeyCode >= Keys.NumPad0) AndAlso (e.KeyCode <= Keys.Divide))) OrElse (((e.KeyCode >= Keys.OemSemicolon) AndAlso (e.KeyCode <= Keys.OemBackslash)) OrElse ((e.KeyCode = Keys.Space) AndAlso Not e.Shift))) AndAlso (Not e.Alt AndAlso Not e.Control)) OrElse MyBase.KeyEntersEditMode(e))
        End Function

#End Region
    End Class

    Public Class DataGridViewRichTextBoxEditingControl
        Inherits RichTextBox
        ' Implements IDataGridViewEditingControl
        Private _dataGridView As DataGridView
        Private _rowIndex As Integer
        Private _valueChanged As Boolean

        Public Sub New()
            Me.BorderStyle = BorderStyle.None
        End Sub

        Protected Overloads Overrides Sub OnTextChanged(ByVal e As EventArgs)
            MyBase.OnTextChanged(e)

            _valueChanged = True
            EditingControlDataGridView.NotifyCurrentCellDirty(True)
        End Sub

        Protected Overloads Overrides Function IsInputKey(ByVal keyData As Keys) As Boolean
            Dim keys__1 As Keys = keyData And Keys.KeyCode
            If keys__1 = Keys.[Return] Then
                Return Me.Multiline
            End If

            Return MyBase.IsInputKey(keyData)
        End Function

        Protected Overloads Overrides Sub OnKeyDown(ByVal e As KeyEventArgs)
            MyBase.OnKeyDown(e)

            If e.Control Then
                Select Case e.KeyCode
                    ' Control + B = Bold 
                    Case Keys.B
                        If Me.SelectionFont.Bold Then
                            Me.SelectionFont = New Font(Me.Font.FontFamily, Me.Font.Size, Not FontStyle.Bold And Me.Font.Style)
                        Else
                            Me.SelectionFont = New Font(Me.Font.FontFamily, Me.Font.Size, FontStyle.Bold Or Me.Font.Style)
                        End If
                        Exit Select
                        ' Control + U = Underline 
                    Case Keys.U
                        If Me.SelectionFont.Underline Then
                            Me.SelectionFont = New Font(Me.Font.FontFamily, Me.Font.Size, Not FontStyle.Underline And Me.Font.Style)
                        Else
                            Me.SelectionFont = New Font(Me.Font.FontFamily, Me.Font.Size, FontStyle.Underline Or Me.Font.Style)
                        End If
                        Exit Select
                    Case Else
                        ' Control + I = Italic 
                        ' Conflicts with the default shortcut 
                        'case Keys.I: 
                        ' if (this.SelectionFont.Italic) 
                        ' { 
                        ' this.SelectionFont = new Font(this.Font.FontFamily, this.Font.Size, ~FontStyle.Italic & this.Font.Style); 
                        ' } 
                        ' else 
                        ' this.SelectionFont = new Font(this.Font.FontFamily, this.Font.Size, FontStyle.Italic | this.Font.Style); 
                        ' break; 
                        Exit Select
                End Select
            End If
        End Sub

#Region "IDataGridViewEditingControl Members"

        Public Sub ApplyCellStyleToEditingControl(ByVal dataGridViewCellStyle As DataGridViewCellStyle)
            Me.Font = dataGridViewCellStyle.Font
        End Sub

        Public Property EditingControlDataGridView() As DataGridView
            Get
                Return _dataGridView
            End Get
            Set(ByVal value As DataGridView)
                _dataGridView = value
            End Set
        End Property

        Public Property EditingControlFormattedValue() As Object
            Get
                Return Me.Rtf
            End Get
            Set(ByVal value As Object)
                If TypeOf value Is String Then
                    Me.Text = TryCast(value, String)
                End If
            End Set
        End Property

        Public Property EditingControlRowIndex() As Integer
            Get
                Return _rowIndex
            End Get
            Set(ByVal value As Integer)
                _rowIndex = value
            End Set
        End Property

        Public Property EditingControlValueChanged() As Boolean
            Get
                Return _valueChanged
            End Get
            Set(ByVal value As Boolean)
                _valueChanged = value
            End Set
        End Property

        Public Function EditingControlWantsInputKey(ByVal keyData As Keys, ByVal dataGridViewWantsInputKey As Boolean) As Boolean
            Select Case (keyData And Keys.KeyCode)
                Case Keys.[Return]
                    If (((keyData And (Keys.Alt Or Keys.Control Or Keys.Shift)) = Keys.Shift) AndAlso Me.Multiline) Then
                        Return True
                    End If
                    Exit Select
                Case Keys.Left, Keys.Right, Keys.Up, Keys.Down
                    Return True
            End Select

            Return Not dataGridViewWantsInputKey
        End Function

        Public ReadOnly Property EditingPanelCursor() As Cursor
            Get
                Return Me.Cursor
            End Get
        End Property

        Public Function GetEditingControlFormattedValue(ByVal context As DataGridViewDataErrorContexts) As Object
            Return Me.Rtf
        End Function

        Public Sub PrepareEditingControlForEdit(ByVal selectAll As Boolean)
        End Sub

        Public ReadOnly Property RepositionEditingControlOnValueChange() As Boolean
            Get
                Return False
            End Get
        End Property

#End Region
    End Class
End Namespace

Open in new window

Avatar of Bob Learned
Bob Learned
Flag of United States of America image

What is the error that you are getting?
Avatar of cobolinx1
cobolinx1

ASKER

EditType property of the current cell does not point to a class that derives from System.Windows.Forms.Control and implements the interface IDataGridViewEditingControl.
Hmmm...this is what I use for a rich text column:


Imports System.Runtime.InteropServices 
Imports System.Drawing 
Imports System.Drawing.Printing 
Imports System.Windows.Forms 
Imports VB6 = Microsoft.VisualBasic.Compatibility.VB6 

Public Class DataGridViewRichTextColumn 
    Inherits DataGridViewColumn 

    Public Sub New() 
        MyBase.New(New DataGridViewRichTextCell) 
    End Sub 

    Public Overrides Property CellTemplate() As DataGridViewCell 
        Get 
            Return MyBase.CellTemplate 
        End Get 
        Set(ByVal value As DataGridViewCell) 

            ' Ensure that the cell used for the template is a CalendarCell. 
            If Not (value Is Nothing) AndAlso _ 
             Not value.GetType().IsAssignableFrom(GetType(DataGridViewRichTextCell)) _ 
             Then 
                Throw New InvalidCastException("Must be a DataGridViewRichTextCell") 
            End If 
            MyBase.CellTemplate = value 

        End Set 
    End Property 

End Class 

Public Class DataGridViewRichTextCell 
    Inherits DataGridViewTextBoxCell 

    Protected Overrides Sub Paint(ByVal graphics As Graphics, _ 
     ByVal clipBounds As Rectangle, ByVal cellBounds As Rectangle, _ 
     ByVal rowIndex As Integer, ByVal cellState As DataGridViewElementStates, _ 
     ByVal value As Object, ByVal formattedValue As Object, _ 
     ByVal errorText As String, ByVal cellStyle As DataGridViewCellStyle, _ 
     ByVal advancedBorderStyle As DataGridViewAdvancedBorderStyle, _ 
     ByVal paintParts As DataGridViewPaintParts) 

        ' Draw the cell background. 
        Dim backColor As Color = Color.White 

        If formattedValue.ToString.IndexOf("v") <> -1 Then 
            backColor = Color.AliceBlue 
        End If 

        Dim brush As New SolidBrush(backColor) 
        graphics.FillRectangle(brush, cellBounds) 
        brush.Dispose() 

        ' Convert the text to Rtf, and then transfer to the Graphics object. 
        RtfTransfer.PaintRtf(formattedValue.ToString(), graphics, cellBounds, cellStyle.Font, backColor) 

        ' Paint the cell border after everything is done, or it will get 
        ' overridden. 
        MyBase.PaintBorder(graphics, clipBounds, cellBounds, cellStyle, advancedBorderStyle) 

    End Sub 

    Public Overrides ReadOnly Property DefaultNewRowValue() As Object 
        Get 
            ' Use the current date and time as the default value. 
            Return String.Empty 
        End Get 
    End Property 

    Private Class RtfTransfer 

        <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)> _ 
        Private Structure CHARRANGE 
            Public cpMin As Integer                  ' First character of range (0 for start of doc) 
            Public cpMax As Integer                  ' Last character of range (-1 for end of doc) 
        End Structure 

        <StructLayout(LayoutKind.Sequential)> _ 
        Private Structure FORMATRANGE 
            Public hdc As IntPtr                         ' Actual DC to draw on 
            Public hdcTarget As IntPtr           ' Target DC for determining text formatting 
            Public rc As RECT                                ' Region of the DC to draw to (in twips) 
            Public rcPage As RECT                        ' Region of the whole DC (page size) (in twips) 
            Public chrg As CHARRANGE                 ' Range of text to draw (see above declaration) 
        End Structure 

        Private Const WM_USER As Integer = &H400 
        Private Const EM_FORMATRANGE As Integer = WM_USER + 57 

        Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _ 
         (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wparam As IntPtr, _ 
         ByVal lparam As IntPtr) As IntPtr 

        ' Render the contents of the RichTextBox for printing 
        '        Return the last character printed + 1 (printing start from this point for next page) 
        Public Shared Sub PaintRtf(ByVal value As String, ByVal gr As Graphics, ByVal bounds As Rectangle, ByVal font As Font, ByVal backColor As Color) 

            If value Is Nothing Then 
                Exit Sub 
            End If 

            ' Use an internal RichTextBox to format the text according to the 
            ' business rules. 

            Dim rtf As New RichTextBox 

            rtf.Font = font 
            rtf.WordWrap = False 
            rtf.Text = value 
            rtf.BackColor = backColor 

            Dim indexIncrease As Integer = value.IndexOf("^") 
            Dim indexDecrease As Integer = value.IndexOf("v") 

            If indexIncrease <> -1 Then 
                rtf.Text = rtf.Text.Remove(indexIncrease, 1) 
                rtf.SelectionStart = indexIncrease 
                rtf.SelectionLength = rtf.TextLength - indexIncrease 
                rtf.SelectionColor = Color.Green 
            ElseIf indexDecrease <> -1 Then 
                rtf.Text = rtf.Text.Remove(indexDecrease, 1) 
                rtf.SelectionStart = indexDecrease 
                rtf.SelectionLength = rtf.TextLength - indexDecrease 
                rtf.SelectionColor = Color.Red 
            End If 

            ' Mark starting and ending character. 
            Dim cRange As CHARRANGE 
            cRange.cpMin = 0 
            cRange.cpMax = value.Length 

            ' Calculate the area to render and print.  The bounds need to 
            ' be converted from pixels to twips (1/1440 of an inch). 

            Dim rectCell As New RECT 
            rectCell.Left = CInt(VB6.PixelsToTwipsX(bounds.Left) + 30) 
            rectCell.Top = CInt(VB6.PixelsToTwipsY(bounds.Top) + 30) 
            rectCell.Right = CInt(VB6.PixelsToTwipsX(bounds.Right)) 
            rectCell.Bottom = CInt(VB6.PixelsToTwipsY(bounds.Bottom)) 

            Dim rectPrint As RECT = rectCell 

            ' Get the DC for the graphics object. 
            Dim hdc As IntPtr = gr.GetHdc() 

            ' Initialize the FORMATRANGE structure for the EM_FORMATRANGE message. 
            Dim fmtRange As FORMATRANGE 
            fmtRange.chrg = cRange                                  ' Indicate character from to character to 
            fmtRange.hdc = hdc                                          ' Use the same DC for measuring and rendering 
            fmtRange.hdcTarget = hdc                                ' Point at printer hDC 
            fmtRange.rc = rectPrint                                 ' Indicate the area on page to print 
            fmtRange.rcPage = rectCell                          ' Indicate whole size of page 

            Dim wparam As IntPtr = New IntPtr(1) 

            ' Pass the FORMATRANGE structure to the lParam handle for the 
            ' EM_FORMATRANGE message sent to the internal RichTextBox. 
            Dim lparam As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(fmtRange)) 
            Marshal.StructureToPtr(fmtRange, lparam, False) 

            ' Tell the RichTextBox to paint on the DC. 
            Dim res As IntPtr = SendMessage(rtf.Handle, EM_FORMATRANGE, wparam, lparam) 

            ' Free the block of memory allocated. 
            Marshal.FreeCoTaskMem(lparam) 

            ' Release the device context handle obtained by a previous call. 
            gr.ReleaseHdc(hdc) 

        End Sub 

    End Class 
End Class

Open in new window

If I used that how would I override the right click so I can bring up my own context menu??
That is a great question...
Do you have the URL for the related question that you have about the context menu?
I merged what you had with the editing control that implements IDataGridViewEditingControl, and my code, but I don't have the requirements for your context menu.


Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Drawing.Printing
Imports System.Windows.Forms
Imports VB6 = Microsoft.VisualBasic.Compatibility.VB6

Public Class DataGridViewRichTextColumn
    Inherits DataGridViewColumn

    Public Sub New()
        MyBase.New(New DataGridViewRichTextCell)
    End Sub

    Public Overrides Property CellTemplate() As DataGridViewCell
        Get
            Return MyBase.CellTemplate
        End Get
        Set(ByVal value As DataGridViewCell)

            ' Ensure that the cell used for the template is a CalendarCell. 
            If Not (value Is Nothing) AndAlso _
             Not value.GetType().IsAssignableFrom(GetType(DataGridViewRichTextCell)) _
             Then
                Throw New InvalidCastException("Must be a DataGridViewRichTextCell")
            End If
            MyBase.CellTemplate = value

        End Set
    End Property

End Class

Public Class DataGridViewRichTextEditor
    Inherits RichTextBox
    Implements IDataGridViewEditingControl

    Private m_dataGridView As DataGridView = Nothing
    Private m_rowIndex As Integer = -1
    Private m_valueChanged As Boolean

    Public Sub ApplyCellStyleToEditingControl(ByVal dataGridViewCellStyle As DataGridViewCellStyle) Implements IDataGridViewEditingControl.ApplyCellStyleToEditingControl
        Me.Font = dataGridViewCellStyle.Font
    End Sub

    Public Property EditingControlDataGridView() As DataGridView Implements IDataGridViewEditingControl.EditingControlDataGridView
        Get
            Return m_dataGridView
        End Get
        Set(ByVal value As DataGridView)
            m_dataGridView = value
        End Set
    End Property

    Public Property EditingControlFormattedValue() As Object Implements IDataGridViewEditingControl.EditingControlFormattedValue
        Get
            Return Me.Rtf
        End Get
        Set(ByVal value As Object)
            Me.Rtf = value
        End Set
    End Property

    Public Property EditingControlRowIndex() As Integer Implements IDataGridViewEditingControl.EditingControlRowIndex
        Get
            Return m_rowIndex
        End Get
        Set(ByVal value As Integer)
            m_rowIndex = value
        End Set
    End Property

    Public Property EditingControlValueChanged() As Boolean Implements IDataGridViewEditingControl.EditingControlValueChanged
        Get
            Return m_valueChanged
        End Get
        Set(ByVal value As Boolean)
            m_valueChanged = value
        End Set
    End Property

    Public Function EditingControlWantsInputKey(ByVal keyData As Keys, ByVal dataGridViewWantsInputKey As Boolean) As Boolean Implements IDataGridViewEditingControl.EditingControlWantsInputKey
        Select Case (keyData And Keys.KeyCode)
            Case Keys.[Return]
                If (((keyData And (Keys.Alt Or Keys.Control Or Keys.Shift)) = Keys.Shift) AndAlso Me.Multiline) Then
                    Return True
                End If
                Exit Select
            Case Keys.Left, Keys.Right, Keys.Up, Keys.Down
                Return True
        End Select

        Return Not dataGridViewWantsInputKey
    End Function

    Public ReadOnly Property EditingPanelCursor() As Cursor Implements IDataGridViewEditingControl.EditingPanelCursor
        Get
            Return Me.Cursor
        End Get
    End Property

    Public Function GetEditingControlFormattedValue(ByVal context As DataGridViewDataErrorContexts) As Object Implements IDataGridViewEditingControl.GetEditingControlFormattedValue
        Return Me.Rtf
    End Function

    Public Sub PrepareEditingControlForEdit(ByVal selectAll As Boolean) Implements IDataGridViewEditingControl.PrepareEditingControlForEdit
        If selectAll Then
            Me.SelectAll()
        End If
    End Sub

    Public ReadOnly Property RepositionEditingControlOnValueChange() As Boolean Implements IDataGridViewEditingControl.RepositionEditingControlOnValueChange
        Get
            Return False
        End Get
    End Property

    Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)

        ' Notify the DataGridView that the contents of the cell have changed.
        Me.EditingControlValueChanged = True
        Me.EditingControlDataGridView.NotifyCurrentCellDirty(True)
        MyBase.OnTextChanged(e)
    End Sub

End Class

Public Class DataGridViewRichTextCell
    Inherits DataGridViewTextBoxCell

    Public Overrides ReadOnly Property EditType() As System.Type
        Get
            Return GetType(DataGridViewRichTextEditor)
        End Get
    End Property

    Public Overrides ReadOnly Property ValueType() As System.Type
        Get
            Return GetType(String)
        End Get
    End Property

    Public Overrides Sub InitializeEditingControl(ByVal rowIndex As Integer, _
        ByVal initialFormattedValue As Object, _
        ByVal dataGridViewCellStyle As DataGridViewCellStyle)

        ' Set the value of the editing control to the current cell value.
        MyBase.InitializeEditingControl(rowIndex, initialFormattedValue, dataGridViewCellStyle)

        Dim ctl As DataGridViewRichTextEditor = CType(DataGridView.EditingControl, DataGridViewRichTextEditor)
        ctl.Rtf = Me.Value
    End Sub

    Protected Overrides Sub Paint(ByVal graphics As Graphics, _
     ByVal clipBounds As Rectangle, ByVal cellBounds As Rectangle, _
     ByVal rowIndex As Integer, ByVal cellState As DataGridViewElementStates, _
     ByVal value As Object, ByVal formattedValue As Object, _
     ByVal errorText As String, ByVal cellStyle As DataGridViewCellStyle, _
     ByVal advancedBorderStyle As DataGridViewAdvancedBorderStyle, _
     ByVal paintParts As DataGridViewPaintParts)

        ' Draw the cell background. 
        Dim backColor As Color = Color.White

        If formattedValue.ToString.IndexOf("v") <> -1 Then
            backColor = Color.AliceBlue
        End If

        Dim brush As New SolidBrush(backColor)
        graphics.FillRectangle(brush, cellBounds)
        brush.Dispose()

        ' Convert the text to Rtf, and then transfer to the Graphics object. 
        RtfTransfer.PaintRtf(formattedValue.ToString(), graphics, cellBounds, cellStyle.Font, backColor)

        ' Paint the cell border after everything is done, or it will get 
        ' overridden. 
        MyBase.PaintBorder(graphics, clipBounds, cellBounds, cellStyle, advancedBorderStyle)

    End Sub

    Public Overrides ReadOnly Property DefaultNewRowValue() As Object
        Get
            ' Use the current date and time as the default value. 
            Return String.Empty
        End Get
    End Property

    Private Class RtfTransfer

        <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)> _
        Private Structure CHARRANGE
            Public cpMin As Integer                  ' First character of range (0 for start of doc) 
            Public cpMax As Integer                  ' Last character of range (-1 for end of doc) 
        End Structure

        <StructLayout(LayoutKind.Sequential)> _
        Private Structure FORMATRANGE
            Public hdc As IntPtr                         ' Actual DC to draw on 
            Public hdcTarget As IntPtr           ' Target DC for determining text formatting 
            Public rc As RECT                                ' Region of the DC to draw to (in twips) 
            Public rcPage As RECT                        ' Region of the whole DC (page size) (in twips) 
            Public chrg As CHARRANGE                 ' Range of text to draw (see above declaration) 
        End Structure

        Private Const WM_USER As Integer = &H400
        Private Const EM_FORMATRANGE As Integer = WM_USER + 57

        Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
         (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wparam As IntPtr, _
         ByVal lparam As IntPtr) As IntPtr

        ' Render the contents of the RichTextBox for printing 
        '        Return the last character printed + 1 (printing start from this point for next page) 
        Public Shared Sub PaintRtf(ByVal value As String, ByVal gr As Graphics, ByVal bounds As Rectangle, ByVal font As Font, ByVal backColor As Color)

            If value Is Nothing Then
                Exit Sub
            End If

            ' Use an internal RichTextBox to format the text according to the 
            ' business rules. 

            Dim rtf As New RichTextBox

            rtf.Font = font
            rtf.WordWrap = False
            rtf.Rtf = value
            rtf.BackColor = backColor

            ' Mark starting and ending character. 
            Dim cRange As CHARRANGE
            cRange.cpMin = 0
            cRange.cpMax = value.Length

            ' Calculate the area to render and print.  The bounds need to 
            ' be converted from pixels to twips (1/1440 of an inch). 

            Dim rectCell As New RECT
            rectCell.Left = CInt(VB6.PixelsToTwipsX(bounds.Left) + 30)
            rectCell.Top = CInt(VB6.PixelsToTwipsY(bounds.Top) + 30)
            rectCell.Right = CInt(VB6.PixelsToTwipsX(bounds.Right))
            rectCell.Bottom = CInt(VB6.PixelsToTwipsY(bounds.Bottom))

            Dim rectPrint As RECT = rectCell

            ' Get the DC for the graphics object. 
            Dim hdc As IntPtr = gr.GetHdc()

            ' Initialize the FORMATRANGE structure for the EM_FORMATRANGE message. 
            Dim fmtRange As FORMATRANGE
            fmtRange.chrg = cRange                                  ' Indicate character from to character to 
            fmtRange.hdc = hdc                                          ' Use the same DC for measuring and rendering 
            fmtRange.hdcTarget = hdc                                ' Point at printer hDC 
            fmtRange.rc = rectPrint                                 ' Indicate the area on page to print 
            fmtRange.rcPage = rectCell                          ' Indicate whole size of page 

            Dim wparam As IntPtr = New IntPtr(1)

            ' Pass the FORMATRANGE structure to the lParam handle for the 
            ' EM_FORMATRANGE message sent to the internal RichTextBox. 
            Dim lparam As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(fmtRange))
            Marshal.StructureToPtr(fmtRange, lparam, False)

            ' Tell the RichTextBox to paint on the DC. 
            Dim res As IntPtr = SendMessage(rtf.Handle, EM_FORMATRANGE, wparam, lparam)

            ' Free the block of memory allocated. 
            Marshal.FreeCoTaskMem(lparam)

            ' Release the device context handle obtained by a previous call. 
            gr.ReleaseHdc(hdc)

        End Sub

    End Class
End Class

Open in new window

I want to right click and bring up a menu to highlight selected text
ASKER CERTIFIED SOLUTION
Avatar of Bob Learned
Bob Learned
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial