RichTextBox is generally broke with drag & drop and multible undo not really working. Implementing syntax highlighting in RichTextBox is a hack that hardly can work without being painful slow and flickering. I would rather use the rock solid Scintilla. With the help of scide which is very mature and Reflector looking at the WinForms code I made a simple Scintilla control, it lacks seriously features, currently I don't need more features for myself.
<br />
Imports System<br />
Imports System.Runtime.InteropServices<br />
Imports System.IO<br />
Imports System.ComponentModel<br />
Imports System.Text<br />
<br />
Imports Stax<br />
Imports Stax.UI<br />
Imports Stax.Win32<br />
<br />
Namespace UI<br />
Public Class Scintilla<br />
Inherits Control<br />
<br />
Private ScintillaHandle As IntPtr<br />
Private DirectPointer As Integer<br />
Private Initialized As Boolean<br />
<br />
Public Sub New()<br />
Dim path As String = CommonDirs.Startup + "SciLexer.dll"<br />
<br />
If File.Exists(path) Then<br />
MyBase.SetStyle(ControlStyles.UserPaint, False)<br />
MyBase.SetStyle(ControlStyles.UseTextForAccessibility, False)<br />
MyBase.SetStyle((ControlStyles.StandardDoubleClick Or ControlStyles.StandardClick), False)<br />
<br />
LoadLibrary("SciLexer.dll")<br />
<br />
ScintillaHandle = CreateWindowEx(0, "Scintilla", "", _<br />
WS.CHILD Or WS.VISIBLE Or WS.TABSTOP, 0, 0, _<br />
Width, Height, Handle, 0, IntPtr.Zero, Nothing)<br />
<br />
DirectPointer = CInt(SlowPerform(2185, 0, 0))<br />
SPerform(2037, CType(65001, UInt32), 0) 'Unicode<br />
<br />
Application.AddMessageFilter(New MessageFiler(AddressOf MessageCallback))<br />
<br />
Initialized = True<br />
Else<br />
BackColor = Color.White<br />
End If<br />
End Sub<br />
<br />
Private Sub MessageCallback(ByRef m As Message, ByRef cancel As Boolean)<br />
If m.HWnd = ScintillaHandle Then<br />
Select Case m.Msg<br />
Case WM.LBUTTONDOWN, WM.RBUTTONDOWN<br />
If Not Focused Then<br />
FindForm.ActiveControl = Me<br />
End If<br />
Case 256, 257, 258, 260, 261 'implements all key event<br />
If CType(GetType(Control).InvokeMember("ProcessKeyMessage", _<br />
Reflection.BindingFlags.Instance Or _<br />
Reflection.BindingFlags.InvokeMethod Or _<br />
Reflection.BindingFlags.NonPublic, _<br />
Nothing, Me, New Object() {m}), Boolean) Then<br />
<br />
cancel = True<br />
End If<br />
End Select<br />
End If<br />
End Sub<br />
<br />
Protected Overrides Function IsInputKey(ByVal keyData As Keys) As Boolean<br />
If (keyData And Keys.Alt) <> Keys.Alt Then<br />
Dim data As Keys = keyData And Keys.KeyCode<br />
<br />
If data <> Keys.Tab Then<br />
Select Case data<br />
Case Keys.Prior, Keys.Next, Keys.End, Keys.Home, _<br />
Keys.Left, Keys.Up, Keys.Right, Keys.Down<br />
<br />
Return True<br />
End Select<br />
Else<br />
Return ((keyData And Keys.Control) = Keys.None)<br />
End If<br />
End If<br />
<br />
Return MyBase.IsInputKey(keyData)<br />
End Function<br />
<br />
#Region " Properties "<br />
Private ReadOnlyValue As Boolean<br />
<br />
<Category("Scintilla"), DefaultValue(False)> _<br />
Public Property [ReadOnly]() As Boolean<br />
Get<br />
If Initialized Then<br />
Return SPerform(2140, 0, 0) <> 0<br />
Else<br />
Return ReadOnlyValue<br />
End If<br />
End Get<br />
Set(ByVal value As Boolean)<br />
ReadOnlyValue = value<br />
<br />
If Initialized Then<br />
If value Then<br />
SPerform(2171, CType(1, System.UInt32), 0)<br />
Else<br />
SPerform(2171, CType(0, System.UInt32), 0)<br />
End If<br />
End If<br />
End Set<br />
End Property<br />
<br />
Public ReadOnly Property Length() As Integer<br />
Get<br />
Return CInt(SPerform(2006, 0, 0))<br />
End Get<br />
End Property<br />
<br />
Private TextValue As String = ""<br />
<br />
Public Overrides Property Text() As String<br />
Get<br />
If Initialized Then<br />
Dim buffer As Byte() = New Byte(Length) {}<br />
Dim ptr As IntPtr = Marshal.AllocHGlobal(buffer.Length)<br />
SPerform(2182, CType(buffer.Length, UInt32), CType(ptr, UInteger))<br />
Marshal.Copy(ptr, buffer, 0, buffer.Length)<br />
Marshal.FreeHGlobal(ptr)<br />
Return UTF8Encoding.UTF8.GetString(buffer, 0, buffer.Length)<br />
End If<br />
<br />
Return TextValue<br />
End Get<br />
Set(ByVal value As String)<br />
TextValue = value<br />
<br />
If Initialized Then<br />
If value Is Nothing Then<br />
value = ""<br />
End If<br />
<br />
Dim buffer As Byte() = UTF8Encoding.UTF8.GetBytes(value + ChrW(0))<br />
Dim ptr As IntPtr = Marshal.AllocHGlobal(buffer.Length)<br />
Marshal.Copy(buffer, 0, ptr, buffer.Length)<br />
SPerform(2181, 0, CType(ptr, UInteger))<br />
Marshal.FreeHGlobal(ptr)<br />
End If<br />
End Set<br />
End Property<br />
<br />
Protected Overrides ReadOnly Property CreateParams() As CreateParams<br />
Get<br />
Dim ret As CreateParams = MyBase.CreateParams<br />
ret.ExStyle = ret.ExStyle Or CInt(WS.EX_CLIENTEDGE)<br />
Return ret<br />
End Get<br />
End Property<br />
#End Region<br />
<br />
#Region " Focus Management "<br />
Private Function GetScintillaFocus() As Boolean<br />
'Debug.WriteLine("GetScintillaFocus")<br />
<br />
If Initialized Then<br />
Return SPerform(2381, 0, 0) <> 0<br />
End If<br />
End Function<br />
<br />
Private Sub SetScintillaFocus(ByVal focus As Boolean)<br />
If Initialized Then<br />
If focus Then<br />
'Debug.WriteLine("SetScintillaFocus true")<br />
SPerform(2380, CType(1, System.UInt32), 0)<br />
Else<br />
'Debug.WriteLine("SetScintillaFocus false")<br />
SPerform(2380, CType(0, System.UInt32), 0)<br />
End If<br />
End If<br />
End Sub<br />
<br />
Protected Overrides Sub OnGotFocus(ByVal e As EventArgs)<br />
'Debug.WriteLine("OnGotFocus")<br />
SetScintillaFocus(SetFocus(ScintillaHandle) <> IntPtr.Zero)<br />
End Sub<br />
<br />
Protected Overrides Sub OnLostFocus(ByVal e As EventArgs)<br />
'Debug.WriteLine("OnLostFocus")<br />
SetScintillaFocus(False)<br />
End Sub<br />
<br />
Public Overrides ReadOnly Property Focused() As Boolean<br />
Get<br />
'Debug.WriteLine("Focused")<br />
Return GetScintillaFocus()<br />
End Get<br />
End Property<br />
#End Region<br />
<br />
#Region " Native Functions "<br />
<DllImport("kernel32")> _<br />
Private Shared Function LoadLibrary(ByVal lpLibFileName As String) As IntPtr<br />
End Function<br />
<br />
<CLSCompliant(False), DllImport("user32")> _<br />
Private Shared Function CreateWindowEx(ByVal dwExStyle As UInteger, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As UInteger, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal hWndParent As IntPtr, ByVal hMenu As Integer, ByVal hInstance As IntPtr, ByVal lpParam As String) As IntPtr<br />
End Function<br />
<br />
<CLSCompliant(False), DllImport("user32.dll")> _<br />
Private Shared Function SendMessage(ByVal hWnd As Integer, ByVal msg As UInt32, ByVal wParam As Integer, ByVal lParam As Integer) As Integer<br />
End Function<br />
<br />
<DllImport("user32.dll")> _<br />
Private Shared Function SetWindowPos(ByVal hWnd As IntPtr, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal uFlags As Integer) As Integer<br />
End Function<br />
<br />
<CLSCompliant(False), DllImport("scilexer.dll", EntryPoint:="Scintilla_DirectFunction")> _<br />
Private Shared Function Perform(ByVal directPointer As Integer, ByVal message As UInt32, ByVal wParam As UInt32, ByVal lParam As UInt32) As Integer<br />
End Function<br />
<br />
<CLSCompliant(False)> _<br />
Private Function SlowPerform(ByVal message As UInt32, ByVal wParam As UInt32, ByVal lParam As UInt32) As UInt32<br />
Return CType(SendMessage(CInt(ScintillaHandle), message, CInt(wParam), CInt(lParam)), UInt32)<br />
End Function<br />
<br />
<CLSCompliant(False)> _<br />
Private Function SPerform(ByVal message As UInt32, ByVal wParam As UInt32, ByVal lParam As UInt32) As UInt32<br />
Return CType(Perform(DirectPointer, message, wParam, lParam), UInt32)<br />
End Function<br />
<br />
<DllImport("user32.dll")> _<br />
Public Shared Function SetFocus(ByVal hwnd As IntPtr) As IntPtr<br />
End Function<br />
#End Region<br />
<br />
#Region " Event Handlers "<br />
Private Sub Scintilla_Resize(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Resize<br />
If Initialized Then<br />
SetWindowPos(ScintillaHandle, 0, ClientRectangle.X, ClientRectangle.Y, ClientRectangle.Width, ClientRectangle.Height, 0)<br />
End If<br />
End Sub<br />
#End Region<br />
<br />
End Class<br />
End Namespace<br />
|