The faceless font
I was chatting with Ken Getz the other day about the RichTextBox. Ken pointed out to me that the SelectionFont can sometimes return Nothing. The documentation isn’t specific on when exactly this occurs, but a quick bit of disassembly and Win32 Api cross referencing, and the case is pretty clear. It occurs when the selection has multiple font faces in it. The problem is the font type can’t represent that. In fact you can’t have a faceless Font which is probably what you’d have to have. This is classic example of the “leaky abstraction” 😉
So latter on this was bothering me a bit. Imagine you have a toolbar that displays whether or not the current selection is Bold. If your selection spans font faces, you can’t get that information. And what’s worse is you can’t set the entire selection to Bold. These are simple operations we expect in any word processor.
So what I ended up doing was to extend the RichTextbox and give it properties such as SelectionFontBold. These properties are a tri-state, Off, On, and Indeterminate. The Indeterminate state is for when different parts of the selection have differing Bold state for example.
To use the property you might write code like:
If Me.RichTextBox1.SelectionFontBold = RichTextBoxEx.FontStyleState.On Then
Me.RichTextBox1.SelectionFontBold = RichTextBoxEx.FontStyleState.Off
Else
Me.RichTextBox1.SelectionFontBold = RichTextBoxEx.FontStyleState.On
End If
Oh, and you can happily cast the FontStyleState to a CheckState.
Anyway, here’s the hack code. Enjoy 🙂
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Public Class RichTextBoxEx
Inherits RichTextBox
<Browsable(False), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Public Property SelectionFontBold() As FontStyleState
Get
Return GetSelectionFontStyle(FontStyle.Bold)
End Get
Set(ByVal value As FontStyleState)
If value = FontStyleState.Indeterminate Then Return
SetSelectionFontStyle(FontStyle.Bold, (value = FontStyleState.On))
End Set
End Property
<Browsable(False), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Public Property SelectionFontItalic() As FontStyleState
Get
Return GetSelectionFontStyle(FontStyle.Italic)
End Get
Set(ByVal value As FontStyleState)
If value = FontStyleState.Indeterminate Then Return
SetSelectionFontStyle(FontStyle.Italic, (value = FontStyleState.On))
End Set
End Property
<Browsable(False), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Public Property SelectionFontUnderline() As FontStyleState
Get
Return GetSelectionFontStyle(FontStyle.Underline)
End Get
Set(ByVal value As FontStyleState)
If value = FontStyleState.Indeterminate Then Return
SetSelectionFontStyle(FontStyle.Underline, (value = FontStyleState.On))
End Set
End Property
<Browsable(False), DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)> _
Public Property SelectionFontStrikeOut() As FontStyleState
Get
Return GetSelectionFontStyle(FontStyle.Strikeout)
End Get
Set(ByVal value As FontStyleState)
If value = FontStyleState.Indeterminate Then Return
SetSelectionFontStyle(FontStyle.Strikeout, (value = FontStyleState.On))
End Set
End Property
Public Enum FontStyleState
Off = 0
[On] = 1
Indeterminate = 2
End Enum
#Region “win32 API”
Private Sub SetSelectionFontStyle(ByVal style As FontStyle, ByVal apply As Boolean)
Dim charInfo As CHARFORMAT = New CHARFORMAT
charInfo.dwMask = style
If apply Then charInfo.dwEffects = style
SendMessage(New HandleRef(Me, Me.Handle), EM_SETCHARFORMAT, SCF_SELECTION, charInfo)
End Sub
Private Function GetSelectionFontStyle(ByVal style As FontStyle) As FontStyleState
Dim charInfo As New CHARFORMAT
charInfo.dwMask = style
SendMessage(New HandleRef(Me, Me.Handle), EM_GETCHARFORMAT, SCF_SELECTION, charInfo)
If (charInfo.dwMask And style) = style Then
If (charInfo.dwEffects And style) = style Then
Return FontStyleState.On
Else
Return FontStyleState.Off
End If
Else
Return FontStyleState.Indeterminate
End If
End Function
<StructLayout(LayoutKind.Sequential, Pack:=4)> _
Private Class CHARFORMAT
Public cbSize As Integer
Public dwMask As Integer
Public dwEffects As Integer
Public yHeight As Integer
Public yOffset As Integer
Public crTextColor As Integer
Public bCharSet As Byte
Public bPitchAndFamily As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)> _
Public szFaceName As Byte()
Public Sub New()
Me.cbSize = Marshal.SizeOf(GetType(CHARFORMAT))
ReDim Me.szFaceName(31)
End Sub
End Class
Private Declare Auto Function SendMessage Lib “user32” (ByVal hWnd As HandleRef, ByVal msg As Int32, ByVal wParam As Int32, <[In](), Out()> ByVal lParam As CHARFORMAT) As IntPtr
Private Const WM_USER As Int32 = &H400
Private Const EM_GETCHARFORMAT As Int32 = (WM_USER + 58)
Private Const EM_SETCHARFORMAT As Int32 = (WM_USER + 68)
Private Const SCF_SELECTION As Int32 = 1
#End Region
End Class
Sure seems like a better approach. This is certainly a precedented solution to the problem. Thanks!