Содать каретку
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