1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284
|
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Drawing.Printing
' An extension to RichTextBox suitable for printing
Public Class RichTextBoxEx
Inherits RichTextBox
<StructLayout(LayoutKind.Sequential)> _
Private Structure STRUCT_RECT
Public left As Int32
Public top As Int32
Public right As Int32
Public bottom As Int32
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure STRUCT_CHARRANGE
Public cpMin As Int32
Public cpMax As Int32
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure STRUCT_FORMATRANGE
Public hdc As IntPtr
Public hdcTarget As IntPtr
Public rc As STRUCT_RECT
Public rcPage As STRUCT_RECT
Public chrg As STRUCT_CHARRANGE
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure STRUCT_CHARFORMAT
Public cbSize As Integer
Public dwMask As UInt32
Public dwEffects As UInt32
Public yHeight As Int32
Public yOffset As Int32
Public crTextColor As Int32
Public bCharSet As Byte
Public bPitchAndFamily As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)> _
Public szFaceName() As Char
End Structure
<DllImport("user32.dll")> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, _
ByVal msg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As IntPtr) As Int32
End Function
' Windows Message defines
Private Const WM_USER As Int32 = &H400&
Private Const EM_FORMATRANGE As Int32 = WM_USER + 57
Private Const EM_GETCHARFORMAT As Int32 = WM_USER + 58
Private Const EM_SETCHARFORMAT As Int32 = WM_USER + 68
' Defines for EM_GETCHARFORMAT/EM_SETCHARFORMAT
Private SCF_SELECTION As Int32 = &H1&
Private SCF_WORD As Int32 = &H2&
Private SCF_ALL As Int32 = &H4&
' Defines for STRUCT_CHARFORMAT member dwMask
' (Long because UInt32 is not an intrinsic type)
Private Const CFM_BOLD As Long = &H1&
Private Const CFM_ITALIC As Long = &H2&
Private Const CFM_UNDERLINE As Long = &H4&
Private Const CFM_STRIKEOUT As Long = &H8&
Private Const CFM_PROTECTED As Long = &H10&
Private Const CFM_LINK As Long = &H20&
Private Const CFM_SIZE As Long = &H80000000&
Private Const CFM_COLOR As Long = &H40000000&
Private Const CFM_FACE As Long = &H20000000&
Private Const CFM_OFFSET As Long = &H10000000&
Private Const CFM_CHARSET As Long = &H8000000&
' Defines for STRUCT_CHARFORMAT member dwEffects
Private Const CFE_BOLD As Long = &H1&
Private Const CFE_ITALIC As Long = &H2&
Private Const CFE_UNDERLINE As Long = &H4&
Private Const CFE_STRIKEOUT As Long = &H8&
Private Const CFE_PROTECTED As Long = &H10&
Private Const CFE_LINK As Long = &H20&
Private Const CFE_AUTOCOLOR As Long = &H40000000&
' Calculate or render the contents of our RichTextBox for printing
'
' Parameter "measureOnly": If true, only the calculation is performed,
' otherwise the text is rendered as well
' Parameter "e": The PrintPageEventArgs object from the PrintPage event
' Parameter "charFrom": Index of first character to be printed
' Parameter "charTo": Index of last character to be printed
' Return value: (Index of last character that fitted on the page) + 1
Public Function FormatRange(ByVal measureOnly As Boolean, _
ByVal e As PrintPageEventArgs, _
ByVal charFrom As Integer, _
ByVal charTo As Integer) As Integer
' Specify which characters to print
Dim cr As STRUCT_CHARRANGE
cr.cpMin = charFrom
cr.cpMax = charTo
' Specify the area inside page margins
Dim rc As STRUCT_RECT
rc.top = HundredthInchToTwips(e.MarginBounds.Top)
rc.bottom = HundredthInchToTwips(e.MarginBounds.Bottom)
rc.left = HundredthInchToTwips(e.MarginBounds.Left)
rc.right = HundredthInchToTwips(e.MarginBounds.Right)
' Specify the page area
Dim rcPage As STRUCT_RECT
rcPage.top = HundredthInchToTwips(e.PageBounds.Top)
rcPage.bottom = HundredthInchToTwips(e.PageBounds.Bottom)
rcPage.left = HundredthInchToTwips(e.PageBounds.Left)
rcPage.right = HundredthInchToTwips(e.PageBounds.Right)
' Get device context of output device
Dim hdc As IntPtr
hdc = e.Graphics.GetHdc()
' Fill in the FORMATRANGE structure
Dim fr As STRUCT_FORMATRANGE
fr.chrg = cr
fr.hdc = hdc
fr.hdcTarget = hdc
fr.rc = rc
fr.rcPage = rcPage
' Non-Zero wParam means render, Zero means measure
Dim wParam As Int32
If measureOnly Then
wParam = 0
Else
wParam = 1
End If
' Allocate memory for the FORMATRANGE struct and
' copy the contents of our struct to this memory
Dim lParam As IntPtr
lParam = Marshal.AllocCoTaskMem(Marshal.SizeOf(fr))
Marshal.StructureToPtr(fr, lParam, False)
' Send the actual Win32 message
Dim res As Integer
res = SendMessage(Handle, EM_FORMATRANGE, wParam, lParam)
' Free allocated memory
Marshal.FreeCoTaskMem(lParam)
' and release the device context
e.Graphics.ReleaseHdc(hdc)
Return res
End Function
' Convert between 1/100 inch (unit used by the .NET framework)
' and twips (1/1440 inch, used by Win32 API calls)
'
' Parameter "n": Value in 1/100 inch
' Return value: Value in twips
Private Function HundredthInchToTwips(ByVal n As Integer) As Int32
Return Convert.ToInt32(n * 14.4)
End Function
' Free cached data from rich edit control after printing
Public Sub FormatRangeDone()
Dim lParam As New IntPtr(0)
SendMessage(Handle, EM_FORMATRANGE, 0, lParam)
End Sub
' Sets the font only for the selected part of the rich text box
' without modifying the other properties like size or style
' <param name="face">Name of the font to use</param>
' <returns>true on success, false on failure</returns>
Public Function SetSelectionFont(ByVal face as String) As Boolean
Dim cf As New STRUCT_CHARFORMAT()
cf.cbSize = Marshal.SizeOf(cf)
cf.dwMask = Convert.ToUInt32(CFM_FACE)
' ReDim face name to relevant size
ReDim cf.szFaceName(32)
face.CopyTo(0, cf.szFaceName, 0, Math.Min(31, face.Length))
Dim lParam As IntPtr
lParam = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
Marshal.StructureToPtr(cf, lParam, False)
Dim res As Integer
res = SendMessage(Handle, EM_SETCHARFORMAT, SCF_SELECTION, lParam)
If (res = 0) Then
Return True
Else
Return False
End If
End Function
' Sets the font size only for the selected part of the rich text box
' without modifying the other properties like font or style
' <param name="size">new point size to use</param>
' <returns>true on success, false on failure</returns>
Public Function SetSelectionSize(ByVal size As Integer) As Boolean
Dim cf As New STRUCT_CHARFORMAT()
cf.cbSize = Marshal.SizeOf(cf)
cf.dwMask = Convert.ToUInt32(CFM_SIZE)
' yHeight is in 1/20 pt
cf.yHeight = size * 20
Dim lParam As IntPtr
lParam = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
Marshal.StructureToPtr(cf, lParam, False)
Dim res As Integer
res = SendMessage(Handle, EM_SETCHARFORMAT, SCF_SELECTION, lParam)
If (res = 0) Then
Return True
Else
Return False
End If
End Function
' Sets the bold style only for the selected part of the rich text box
' without modifying the other properties like font or size
' <param name="bold">make selection bold (true) or regular (false)</param>
' <returns>true on success, false on failure</returns>
Public Function SetSelectionBold(ByVal bold As Boolean) As Boolean
If (bold) Then
Return SetSelectionStyle(CFM_BOLD, CFE_BOLD)
Else
Return SetSelectionStyle(CFM_BOLD, 0)
End If
End Function
' Sets the italic style only for the selected part of the rich text box
' without modifying the other properties like font or size
' <param name="italic">make selection italic (true) or regular (false)</param>
' <returns>true on success, false on failure</returns>
Public Function SetSelectionItalic(ByVal italic As Boolean) As Boolean
If (italic) Then
Return SetSelectionStyle(CFM_ITALIC, CFE_ITALIC)
Else
Return SetSelectionStyle(CFM_ITALIC, 0)
End If
End Function
' Sets the underlined style only for the selected part of the rich text box
' without modifying the other properties like font or size
' <param name="underlined">make selection underlined (true) or regular (false)</param>
' <returns>true on success, false on failure</returns>
Public Function SetSelectionUnderlined(ByVal underlined As Boolean) As Boolean
If (underlined) Then
Return SetSelectionStyle(CFM_UNDERLINE, CFE_UNDERLINE)
Else
Return SetSelectionStyle(CFM_UNDERLINE, 0)
End If
End Function
' Set the style only for the selected part of the rich text box
' with the possibility to mask out some styles that are not to be modified
' <param name="mask">modify which styles?</param>
' <param name="effect">new values for the styles</param>
' <returns>true on success, false on failure</returns>
Private Function SetSelectionStyle(ByVal mask As Int32, ByVal effect As Int32) As Boolean
Dim cf As New STRUCT_CHARFORMAT()
cf.cbSize = Marshal.SizeOf(cf)
cf.dwMask = Convert.ToUInt32(mask)
cf.dwEffects = Convert.ToUInt32(effect)
Dim lParam As IntPtr
lParam = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
Marshal.StructureToPtr(cf, lParam, False)
Dim res As Integer
res = SendMessage(Handle, EM_SETCHARFORMAT, SCF_SELECTION, lParam)
If (res = 0) Then
Return True
Else
Return False
End If
End Function
End Class |
Partager