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 DataGridViewCellMouseEvent Args)
      MyBase.OnMouseClick(e)
      If MyBase.DataGridView IsNot Nothing Then
        Dim currentCellAddress As Point = MyBase.DataGridView.Curren tCellAddre ss
        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.EditMo de <> DataGridViewEditMode.EditP rogrammati cally Then
            MyBase.DataGridView.BeginE dit(False)  ''''  it happens here
          End If
        End If
      End If
    End Sub
    Protected Overloads Overrides Sub OnMouseClick(ByVal e As DataGridViewCellMouseEvent
      MyBase.OnMouseClick(e)
      If MyBase.DataGridView IsNot Nothing Then
        Dim currentCellAddress As Point = MyBase.DataGridView.Curren
        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.EditMo
            MyBase.DataGridView.BeginE
          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
What is the error that you are getting?
ASKER
EditType property of the current cell does not point to a class that derives from System.Windows.Forms.Contr ol and implements the interface IDataGridViewEditingContro l.
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
ASKER
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 IDataGridViewEditingContro l, 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
ASKER
I want to right click and bring up a menu to highlight selected text
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.