VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cColor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const WM_SETREDRAW = &HB

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 KeinRefresh Lib "user32" Alias "LockWindowUpdate" (ByVal hwndLock As Long) As Long
         
Private Const SeFile As String = "\data.txt"

Private ReCode      As String
Private WordList()  As String
Private sTemp      As String
Private tTemp      As Long
Private Query  As String

Private Pos  As Long
Private i      As Long

Public Sub LockBox(TextBox As RichTextBox)

    Dim X As Long
    X = SendMessage(TextBox.hwnd, WM_SETREDRAW, 0, 0)
    KeinRefresh TextBox.hwnd

End Sub

Public Sub UnlockBox(TextBox As RichTextBox)
    
    Dim X As Long
    KeinRefresh 0&
    X = SendMessage(TextBox.hwnd, WM_SETREDRAW, 1, 0)
   
End Sub

Public Sub ColorLine(ByVal TextBox As RichTextBox, Optional xLine As Long = -1)
    Call Color(xLine, TextBox)
End Sub

Public Sub ChangeLine(ByVal Line As Integer, ByVal TextBox As RichTextBox)

Dim Start As Long
Dim Ende  As Long

  'Colors a Line complete black
  'Start& = GetPos(Textbox.Text, Line) + 1
  'Ende& = GetEnd(Mid(Textbox.Text, Start))
  
  Start = rtf.LinePosition(TextBox, Line - 1)
  Ende = rtf.LineLength(TextBox, Line - 1)
  
  rtf.SetPos TextBox, Start
  TextBox.SelLength = Ende
  TextBox.SelColor = vbBlack

End Sub

Private Sub Color(ByVal Line As Integer, ByVal TextBox As RichTextBox)

Dim Start As Long
Dim Ende  As Long
Dim Cap As Boolean

  'Start = GetPos(Textbox.Text, CInt(Line)) + 1
  'Ende = GetEnd(Mid(Textbox.Text, Start))
  Start = rtf.LinePosition(TextBox, Line - 1) + 1
  Ende = rtf.LineLength(TextBox, Line - 1)
    
  rtf.SetPos TextBox, Start
  TextBox.SelLength = Ende
  TextBox.SelColor = vbBlack

  If Start = 0 Then Start = 1
  
  'Query$ = Mid$(Textbox.Text, Start, Ende)
  Query = rtf.LineText(TextBox, Line - 1)
  If Len(Query) = 0 Then Exit Sub
  Query = Query & " "
  
'find words in text and highlight it
For i& = 1 To Len(Query)
  Ende = Asc(Mid$(Query$, i, 1))
  
  Select Case Ende

  Case 97 To 122, 65 To 90, 35, 34, 46
  
    If Cap And Ende = 34 Then Cap = False Else If Ende = 34 Then Cap = True

    If sTemp = vbNullString Then Pos = i
    sTemp = sTemp & Chr(Ende)
  
  Case Else
  
    If Ende = 39 Then Exit For
    
    If Cap = False Then
        tTemp = InStr(1, ReCode$, "|" & sTemp$ & "|", 1)
        If tTemp <> 0 Then
            rtf.SetPos TextBox, Pos + Start - 2
            TextBox.SelLength = Len(sTemp)
            TextBox.SelColor = &H800000
            TextBox.SelText = Mid(ReCode, tTemp + 1, Len(sTemp))
        End If
    End If
    
    sTemp = vbNullString
    
  End Select

Next i
  
  '--- Finds Comments - Simply and Clean ---------
 
  Pos = InStr(Query, "'")
  
  If Pos > 0 Then
  rtf.SetPos TextBox, Pos + Start - 2
  TextBox.SelLength = Len(Query$) - Pos + 1
  TextBox.SelColor = &H8000&
  End If
  
  If LCase(Left$(Query$, 4)) = "rem " Then
  rtf.SetPos TextBox, Start - 1
  TextBox.SelLength = Len(Query)
  TextBox.SelColor = &H8000&
  rtf.SetPos TextBox, Start - 1
  TextBox.SelLength = 1
  TextBox.SelText = "R"
  End If
                                       
End Sub

Public Sub ReadList()
Dim FN    As Integer
Dim Data  As String


  FN = FreeFile

  Open App.Path & SeFile For Input As #FN
    Do While Not EOF(FN)
     Input #FN, Data
      ReCode = ReCode & "|" & Data
      i = i + 1
      ReDim Preserve WordList(i) As String
      WordList(i) = Data
    Loop
  Close FN
  ReCode = ReCode & "|"

End Sub
