VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CRtfEx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                    '
' CRtfEx Class                                       '
' Created by Joacim Andersson 21 April 1999          '
'                                                    '
' E-Mail me at: joacim@sourceedit.com                '
'                                                    '
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'API function declarations
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

'Window messages sent to the textbox
Private Const EM_CANUNDO = &HC6
Private Const EM_GETFIRSTVISIBLELINE = &HCE
Private Const EM_GETLINE = &HC4
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETMODIFY = &HB8
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_SETMODIFY = &HB9
Private Const EM_UNDO = &HC7

'local variables to hold property values
Private WithEvents mtxtBox As RichTextBox
Attribute mtxtBox.VB_VarHelpID = -1
Private mhWnd As Long 'the hWnd of the textbox
Private m_TabChar As String
Private m_blnKeepIndent As Boolean

Public Property Get CurrentLine() As Long
    CurrentLine = GetLineFromChar(mtxtBox.SelStart)
End Property

Public Property Get CurrentCol() As Long
    CurrentCol = ColPosition
End Property

Public Property Get KeepIndent() As Boolean
    KeepIndent = m_blnKeepIndent
End Property

Public Property Let KeepIndent(blnNewValue As Boolean)
    m_blnKeepIndent = blnNewValue
End Property

Public Property Get TabChar() As String
    TabChar = m_TabChar
End Property

Public Property Let TabChar(sNewValue As String)
    If Len(sNewValue) Then
        m_TabChar = Left$(sNewValue, 1)
    End If
End Property

Public Function LineLen(CharPos As Long)
'Returns the number of character of the line that
'contains the character position specified by CharPos
    LineLen = SendMessage(mhWnd, EM_LINELENGTH, CharPos, 0&)
End Function

Public Function GetLineFromChar(CharPos As Long) As Long
'Returns the zero based line number of the line
'that contains the specified character index
    GetLineFromChar = SendMessage(mhWnd, EM_LINEFROMCHAR, CharPos, 0&)
End Function

Public Function LineCount() As Long
'Returns the number of lines in the textbox
    LineCount = SendMessage(mhWnd, EM_GETLINECOUNT, 0&, 0&)
End Function

Public Function TopLine() As Long
'Returns the zero based line index of the first
'visible line in a multiline textbox.
'Or the position of the first visible character
'in a none multiline textbox
    TopLine = SendMessage(mhWnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
End Function

Public Function CanUndo() As Boolean
'Returns True if it's possible to make an Undo
    Dim lngRetVal As Long
    
    lngRetVal = SendMessage(mhWnd, EM_CANUNDO, 0&, 0&)
    CanUndo = (lngRetVal <> 0)
End Function

Public Function GetCharFromLine(LineIndex As Long) As Long
'Returns the index of the first character of the line
    'check if LineIndex is valid
    If LineIndex < LineCount Then
        GetCharFromLine = SendMessage(mhWnd, EM_LINEINDEX, LineIndex, 0&)
    End If
End Function

Public Function GetLine(LineIndex As Long) As String
'Returns the text contained at the specified line
    Dim bArray() As Byte 'byte array to contain the returned string
    Dim lngLineLen As Long 'the length of the line
    Dim sRetVal As String 'the return value
    
    'Check the LineIndex value
    If LineIndex >= LineCount Then
        GetLine = ""
        Exit Function
    End If
    'get the length of the line
    lngLineLen = LineLen(GetCharFromLine(LineIndex))
    If lngLineLen < 1 Then
        GetLine = ""
        Exit Function
    End If
    ReDim bArray(lngLineLen + 1)
    'The first word of the array must contain
    'the length of the line to return
    bArray(0) = lngLineLen And 255
    bArray(1) = lngLineLen \ 256
    SendMessage mhWnd, EM_GETLINE, LineIndex, bArray(0)
    'convert the byte array into a string
    sRetVal = Left(StrConv(bArray, vbUnicode), lngLineLen)
    'return the string
    GetLine = sRetVal
End Function

Public Sub Undo()
'Undo the last edit
    SendMessage mhWnd, EM_UNDO, 0&, 0&
End Sub

Public Sub DelLine(LineIndex As Long)
    'Deletes the specified line from the textbox
    Dim lngSelStart As Long 'used to save the caret position
    Dim lngLineLen As Long  'the length of the line to delete
    Dim lngCharPos As Long  'the index of the first character on the line
    
    If LineIndex >= LineCount Then
        Exit Sub
    End If
    lngSelStart = mtxtBox.SelStart
    lngCharPos = GetCharFromLine(LineIndex)
    lngLineLen = LineLen(lngCharPos)
    mtxtBox.Text = Left$(mtxtBox.Text, lngCharPos) & Mid$(mtxtBox.Text, lngCharPos + lngLineLen + 3)
    mtxtBox.SelStart = lngCharPos
End Sub

Public Sub SelectLine(LineIndex As Long)
'Selects the specified line
    If LineIndex < LineCount Then
        mtxtBox.SelStart = GetCharFromLine(LineIndex)
        mtxtBox.SelLength = LineLen(mtxtBox.SelStart)
    End If
End Sub

Public Property Let IsDirty(ByVal blnDirty As Boolean)
Attribute IsDirty.VB_Description = "    "
    Dim lngDirty As Long
    
    lngDirty = Abs(blnDirty) '1 = True in API functions not -1 as in VB
    SendMessage mhWnd, EM_SETMODIFY, lngDirty, 0&
End Property

Public Property Get IsDirty() As Boolean
    IsDirty = (SendMessage(mhWnd, EM_GETMODIFY, 0&, 0&) <> 0)
End Property

Public Property Set TextBox(txtNewBox As RichTextBox)
    Set mtxtBox = txtNewBox
    mhWnd = txtNewBox.hwnd
End Property

Public Property Get TextBox() As RichTextBox
    Set TextBox = mtxtBox
End Property

Public Function ColPosition() As Long
Attribute ColPosition.VB_Description = "Depricated! Use the CurrentCol property instead."
Attribute ColPosition.VB_MemberFlags = "40"
    Dim lngFirstCharPos&
    
    lngFirstCharPos = GetCharFromLine(GetLineFromChar(mtxtBox.SelStart))
    ColPosition = mtxtBox.SelStart - lngFirstCharPos
End Function

Private Sub Class_Initialize()
    m_TabChar = vbTab
End Sub

Private Sub mtxtBox_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim lngLineIndex As Long
    Dim s As String, s2 As String

    If Shift = vbCtrlMask Then
        Select Case KeyCode
'            Case vbKeyA 'CTRL+A = Select all
'                With mtxtBox
'                    .SelStart = 0
'                    .SelLength = Len(.Text)
'                End With
            Case vbKeyY 'CTRL+Y = Cut current line and put it on the clipboard
                KeyCode = 0
                Shift = 0
                lngLineIndex = mtxtBox.GetLineFromChar(mtxtBox.SelStart)
                Clipboard.Clear
                s = GetLine(lngLineIndex)
                Clipboard.SetText s & vbCrLf
                DelLine lngLineIndex
        End Select
    ElseIf Shift = 0 Then
        Select Case KeyCode
            Case vbKeyReturn
                If m_blnKeepIndent Then
                    KeyCode = 0
                    lngLineIndex = mtxtBox.GetLineFromChar(mtxtBox.SelStart)
                    s = GetLine(lngLineIndex)
                    Do While Left$(s, 1) = m_TabChar
                        s2 = s2 & m_TabChar
                        s = Mid$(s, 2)
                    Loop
                    mtxtBox.SelText = vbCrLf & s2
                End If
        End Select
    End If
End Sub