'----------------------
' The CTextBoxML class module
'----------------------

Option Explicit

Private Declare Function SendMessage Lib _
   "user32" Alias "SendMessageA" (ByVal hwnd _
   As Long, ByVal wMsg As Long, ByVal wParam As _
   Long, lParam As Any) As Long
Private Declare Function SendMessageByVal Lib _
   "user32" Alias "SendMessageA" (ByVal hwnd _
   As Long, ByVal wMsg As Long, ByVal wParam As _
   Long, ByVal lParam As Long) As Long

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private Const EM_CANUNDO = &HC6
Private Const EM_UNDO = &HC7
Private Const EM_EMPTYUNDOBUFFER = &HCD
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_FMTLINES = &HC8
Private Const EM_GETLINE = &HC4
Private Const EM_GETRECT = &HB2
Private Const EM_SCROLL = &HB5
Private Const EM_SCROLLCARET = &HB7
Private Const EM_SETRECT = &HB3
Private Const EM_SETTABSTOPS = &HCB
Private Const EM_LINESCROLL = &HB6

' The control being encapsulated
Public Ctrl As TextBox

'----------------------
' Undo operations
'---------------------- 

' Return True if the most recent edit can be 
' undone.
Function CanUndo() As Boolean
   CanUndo = SendMessageByVal(Ctrl.hWnd, _
   EM_CANUNDO, 0, 0)
End Function

' Undo the most recent edit operation.
Sub Undo()
   SendMessageByVal Ctrl.hwnd, EM_UNDO, 0, 0
End Sub

' Empty the undo buffer.
Sub EmptyUndoBuffer()
   SendMessageByVal Ctrl.hwnd, _
      EM_EMPTYUNDOBUFFER, 0, 0
End Sub

'----------------------
' Multiline controls
'----------------------

' Return the number of lines in the control.

Property Get LineCount() As Long
   LineCount = SendMessageByVal(Ctrl.hwnd, _
      EM_GETLINECOUNT, 0, 0)
End Property

' Return the index of the first visible line
' (0 for the first text line in the control).
' When applied to a single-line control, return 
' the index of the first visible character
' (0 for the first character in the control).

Property Get FirstVisibleLine() As Long
   FirstVisibleLine = _
      SendMessageByVal(Ctrl.hwnd, _
      EM_GETFIRSTVISIBLELINE, 0, 0)
End Property

' Return the number of the line that contains the 
' specified character.
' Both line and character numbers are zero-based.

Function LineFromChar(ByVal charIndex As Long) _
   As Long
   LineFromChar = SendMessageByVal(Ctrl.hwnd, _
      EM_LINEFROMCHAR, charIndex, 0)
End Function

' Return the offset of the first character of a 
' line.

Function LineIndex(ByVal lineNum As Long) As Long
   LineIndex = SendMessageByVal(Ctrl.hwnd, _
      EM_LINEINDEX, lineNum, 0)
End Function

' Return the length of the specified line.

Function LineLength(ByVal lineNum As Long) As Long
   Dim charOffset As Long
   ' Retrieve the offset of first character in 
   ' the line.
   charOffset = SendMessageByVal(Ctrl.hwnd, _
      EM_LINEINDEX, lineNum, 0)
   ' Now it is possible to get the length of the 
   ' line.
   LineLength = SendMessageByVal(Ctrl.hwnd, _
      EM_LINELENGTH, charOffset, 0)
End Function

' Return the specified line.

Function GetLine(ByVal lineNum As Long) As String
   Dim charOffset As Long, lineLen As Long
   ' Retrieve the offset of first character in 
   ' the line.
   charOffset = SendMessageByVal(Ctrl.hwnd, _
      EM_LINEINDEX, lineNum, 0)
   ' Now it is possible to get the length of the 
   ' line.
   lineLen = SendMessageByVal(Ctrl.hwnd, _
      EM_LINELENGTH, charOffset, 0)
   ' Extract the line text.
   GetLine = Mid$(Ctrl.Text, charOffset + 1, _
      lineLen)
End Function

' Get the line/column coordinates of a given 
' character (both are zero-based). If charIndex is 
' negative, it returns the coordinates 
' of the caret 

Sub GetLineColumn(ByVal charIndex As Long, line _
   As Long, column As Long)
      If charIndex < 0 Then charIndex = _
         Ctrl.SelStart
      ' Get the line number.
      line = SendMessageByVal(Ctrl.hwnd, _
         EM_LINEFROMCHAR, charIndex, 0)
      ' Get the column number by subtracting the 
      ' line's start index from the caret 
      ' position
      column = Ctrl.SelStart - SendMessageByVal _
         (Ctrl.hwnd, EM_LINEINDEX, line, 0)
End Sub

' Return an array with all the lines in the 
' control. If argument is True, trailing CR-LFs 
' are preserved.

Function GetAllLines(Optional _
   KeepHardLineBreaks As Boolean) As String()
      Dim res() As String, i As Long
      ' Activate soft line breaks. A soft line 
      ' break is marked by the CR-CR-LF sequence.
      SendMessageByVal Ctrl.hwnd, EM_FMTLINES, _
         True, 0
      ' Retrieve all the lines in one operation. 
      ' This operation leaves a trailing CR 
      ' character for soft line breaks.
      res() = Split(Ctrl.Text, vbCrLf)
      ' We need a loop to trim the trailing CR 
      ' character. If argument is True, we need 
      ' to manually add a CR-LF pair to all the 
      ' lines that don't contain such trailing 
      ' CR char.
      For i = 0 To UBound(res)
         If Right$(res(i), 1) = vbCr Then
            res(i) = Left$(res(i), _
               Len(res(i)) - 1)
         ElseIf KeepHardLineBreaks Then
            res(i) = res(i) & vbCrLf
         End If
      Next
      ' Deactivate soft line breaks.
      SendMessageByVal Ctrl.hwnd, EM_FMTLINES, _
         False, 0
      GetAllLines = res()
End Function

' Scroll the contents of the control.
' Positive values scroll left and up, negative 
' values scroll right and down.

Sub Scroll(HorizScroll As Long, VertScroll As _
   Long)
   SendMessageByVal Ctrl.hwnd, EM_LINESCROLL, _
      HorizScroll, VertScroll
End Sub

' Ensures that the caret is visible.

Sub ScrollCaret()
   SendMessageByVal Ctrl.hwnd, _
      EM_SCROLLCARET, 0, 0
End Sub

' Set tab stops. Each element of the array is 
' expressed in dialog units, where each dialog 
' unit is 1/4 of the 
' average character's width.

Sub SetTabStops(tabStops() As Long)
   Dim numEls As Long
   numEls = UBound(tabStops) - _
      LBound(tabStops) + 1
   SendMessage Ctrl.hwnd, EM_SETTABSTOPS, _
      numEls, tabStops(LBound(tabStops))
End Sub

' Set the tab stop distance, expressed in 
' dialog units.

Sub SetTabStopDistance(ByVal distance As Long)
   SendMessage Ctrl.hwnd, EM_SETTABSTOPS, 1, _
      distance
End Sub