Содать каретку
Imports System.Runtime.InteropServices
Public Class Editor
Inherits Control
Private _BackColor As Color = SystemColors.Window
Private _Font As Font = New Font("Courier New", 12)
Dim x As Integer = 0
Public Overrides Property Font() As System.Drawing.Font
Get
Return _Font
End Get
Set(ByVal value As System.Drawing.Font)
_Font = value
CreateCaret(Me.Handle, IntPtr.Zero, 2, value.Height)
ShowCaret(Me.Handle)
End Set
End Property
Public Overrides Property BackColor() As Color
Get
Return _BackColor
End Get
Set(ByVal value As Color)
_BackColor = value
End Set
End Property
Protected Overrides Sub OnHandleCreated(ByVal e As System.EventArgs)
MyBase.OnHandleCreated(e)
CreateCaret(Me.Handle, IntPtr.Zero, 2, _Font.Height)
ShowCaret(Me.Handle)
SetCaretPos(0, 0)
End Sub
Private Sub InitializeComponent()
Me.SuspendLayout()
Me.ResumeLayout(False)
End Sub
Public Sub New()
Me.SetStyle(ControlStyles.UserPaint, True)
Me.SetStyle(ControlStyles.ResizeRedraw, True)
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
Me.SetStyle(ControlStyles.Selectable, True)
Me.SetStyle(ControlStyles.ContainerControl, True)
End Sub
Private Sub Editor_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.S Then x += 5
If e.KeyCode = Keys.A Then x -= 5
SetCaretPos(x, 0)
End Sub
End Class
Public Module API
<DllImport("user32.dll")> _
Public Function CreateCaret(ByVal hWnd As IntPtr, ByVal hBitmap As IntPtr, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer
End Function
<DllImport("user32.dll")> _
Public Function ShowCaret(ByVal hWnd As IntPtr) As Integer
End Function
<DllImport("user32.dll")> _
Public Function SetCaretPos(ByVal X As Integer, ByVal Y As Integer) As Integer
End Function
End Module
Public Class RichEditBox
Inherits System.Windows.Forms.RichTextBox
<DllImport("User32.dll")> _
Private Shared Function SetClipboardViewer(ByVal hWndNewViewer As IntPtr) As IntPtr
End Function
<DllImport("User32.dll")> _
Private Shared Function ChangeClipboardChain(ByVal hWndRemove As IntPtr, ByVal hWndNewNext As IntPtr) As Boolean
End Function
<DllImport("user32.dll")> _
Private Shared Function SendMessage(ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
End Function
Private Const WM_DRAWCLIPBOARD As Integer = &H308
Private Const WM_CHANGECBCHAIN As Integer = &H30D
Public Event ChangeClipboard As EventHandler
Private nextClipboardViewer As IntPtr = IntPtr.Zero
Protected Overrides Sub OnHandleCreated(ByVal e As System.EventArgs)
MyBase.OnHandleCreated(e)
Me.nextClipboardViewer = SetClipboardViewer(Me.Handle)
End Sub
Protected Overrides Sub OnHandleDestroyed(ByVal e As System.EventArgs)
ChangeClipboardChain(Me.Handle, Me.nextClipboardViewer)
MyBase.OnHandleDestroyed(e)
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Select Case m.Msg
Case WM_DRAWCLIPBOARD
RaiseEvent ChangeClipboard(Me, New EventArgs)
SendMessage(Me.nextClipboardViewer, m.Msg, m.WParam, m.LParam)
Case WM_CHANGECBCHAIN
If Me.nextClipboardViewer.Equals(m.WParam) Then
Me.nextClipboardViewer = m.LParam
Else
SendMessage(Me.nextClipboardViewer, m.Msg, m.WParam, m.LParam)
End If
Case Else
MyBase.WndProc(m)
End Select
End Sub
End Class