Binaryworld - OverwriteHandler - A class for handling overwrite mode ... [ VB -> Forms & Controls ]

'---------------------------------------------------------
' OverwriteHandler class
'
' you can associate this class to a form, using the
' Form property, and all the textbox controls in the
' form will support insert/overwrite mode switching
'
' Usage: Dim ov As New OverwriteHandler
'
'     Private Sub Form_Load()
'      Set ov.Form = Me
'      ' if you want block-shaped caret in ov mode
'      ov.BlockCaret = True
'     End Sub
'
' The class responds as expected to the INS key to
' switch among insert and overwrite mode. You can do
' the same by acting over the OverwriteMode property
'
' The OverwriteMode property is automatically reset to
' false whenever the focus enters a new field, but is
' preserved when the focus shifts to another form and back
'
' The caret shape is not correctly preserved when the input
' focus shifts to another application and then back, but the
' overwrite mode is.
'
' Notes: this class forces the form's KeyPreview property to True
'
'    There are a few controls (most notably, the ComboBox
'    control) for which the block caret doesn't display correctly.
'    Other controls manage the caret in a way that this class
'    can display a custom caret. In such cases you should leave
'    the ShowBlock property to False.
'
'---------------------------------------------------------

Option Explicit

Private Declare Function CreateCaret Lib "user32" (ByVal hWnd As Long, _
  ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function ShowCaret Lib "user32" (ByVal hWnd As Long) As Long

' member variable for OverwriteMode property
Private m_OverwriteMode As Boolean
' member variable for Form property
Private WithEvents HookedForm As Form
' this keeps track of the last active field
Private ActiveControl As Control
' member variable for BlockCaret property
Private m_BlockCaret As Boolean

' The Hooked Form

Public Property Get Form() As Form
  Set Form = HookedForm
End Property

Public Property Set Form(ByVal newValue As Form)
  Set HookedForm = newValue
  ' enforce KeyPreview = True, so that this class
  ' can trap keys pressed in the form
  If Not (HookedForm Is Nothing) Then
    HookedForm.KeyPreview = True
  End If
End Property

' The current Overwrite flag

Public Property Get OverwriteMode() As Boolean
  CheckActiveControl
  OverwriteMode = m_OverwriteMode
End Property

Public Property Let OverwriteMode(ByVal newValue As Boolean)
  m_OverwriteMode = newValue
  UpdateCaret
End Property

' True if the overwrite caret should be displayed as a block

Property Get BlockCaret() As Boolean
  BlockCaret = m_BlockCaret
End Property

Property Let BlockCaret(ByVal newValue As Boolean)
  m_BlockCaret = newValue
  UpdateCaret
End Property

' rebuild the caret block
' at times you may need to call this method directly, for example
' when the focus shift to another application and then back.

Public Sub UpdateCaret()
  On Error Resume Next
  If Not CheckActiveControl Then
    ' active control doesn't support carets
  ElseIf OverwriteMode And BlockCaret Then
    ' show the caret as a block
    CreateCaret ActiveControl.hWnd, 0, 6, 14
    ShowCaret ActiveControl.hWnd
  Else
    ' show the caret as a vertical line
    CreateCaret ActiveControl.hWnd, 0, 1, 14
    ShowCaret ActiveControl.hWnd
  End If
End Sub

' reset the OverwriteMode property if the focus
' has moved to another field
' the function returns True if the active control
' supports a caret

Private Function CheckActiveControl() As Boolean
  If Not Form.ActiveControl Is ActiveControl Then
    Set ActiveControl = Form.ActiveControl
    OverwriteMode = False
  End If
  On Error Resume Next
  ' the following expression is always True, unless the
  ' active control doesn't refer to a textbox
  CheckActiveControl = (ActiveControl.SelLength >= 0)
End Function

' trap user's key presses

Private Sub HookedForm_KeyPress(KeyAscii As Integer)
  On Error Resume Next

  If Not CheckActiveControl Then
    ' active control is not of type textbox
    ' do nothing
  ElseIf m_OverwriteMode And KeyAscii >= 32 And ActiveControl.SelLength = 0 _
    Then
    ' we are in overwrite mode, the user hasn't pressed a
    ' control key and there's no text currently highlighted
    If Mid$(ActiveControl.Text, ActiveControl.SelStart + 1, 1) <> vbCr Then
      ' extend the selection if not at the end of the line
      ActiveControl.SelLength = 1
    End If
  End If
End Sub

' check if INS key has been pressed

Private Sub HookedForm_KeyDown(KeyCode As Integer, Shift As Integer)
  If CheckActiveControl Then
    If KeyCode = 45 And Shift = 0 Then
      ' Insert key has been pressed
      OverwriteMode = Not OverwriteMode
    End If
  End If
End Sub

' rebuild the correct caret when the forms regains the focus

Private Sub HookedForm_Activate()
  If CheckActiveControl Then UpdateCaret
End Sub