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 Const EM_GETLINE = &HC4
Private Const EM_GETSEL = &HB0
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_GETFIRSTVISIBLELINE = &HCE
 
Private Const MAX_CHAR_COUNT = 40           '==> Anzahl der Zeichen
 
 
Private Function GetCurPos(RichTextBox As RichTextBox, _
                            Optional ByRef lngLine As Long, _
                            Optional ByRef lngCursorPos As Long, _
                            Optional ByRef lngFirstChar As Long, _
                            Optional ByRef lngLineLength As Long) As Long
 
 
        lngCursorPos = SendMessage(RichTextBox.hwnd, EM_GETSEL, 0, ByVal 0&) \ _
          65536
        lngLine = SendMessage(RichTextBox.hwnd, EM_LINEFROMCHAR, lngCursorPos, _
        ByVal 0&)
        lngFirstChar = SendMessage(RichTextBox.hwnd, EM_LINEINDEX, lngLine, _
        ByVal 0&)
        lngLineLength = SendMessage(RichTextBox.hwnd, EM_LINELENGTH, _
        lngFirstChar, ByVal 0&)
 
        GetCurPos = RichTextBox.SelStart - lngFirstChar
 
End Function
 
Private Sub cmdOpenFile_Click()
On Error GoTo Err
 
    With CommonDialog1
        .Filter = "TextFiles (*.txt)|*.txt"
        .CancelError = True
        .ShowOpen
 
        RichTextBox1.LoadFile .FileName
 
        Call RTF_ColorAll(RichTextBox1)
 
    End With
 
Exit Sub
Err:
End Sub
 
Private Sub RTF_ColorAll(RichTextBox As RichTextBox)
 
    Dim lPos As Long
    Dim sText As String
    Dim bEnde As Boolean
    Dim l As Long
 
    With RichTextBox1
 
        .Enabled = False
        sText = .Text
 
        lPos = 1
        bEnde = False
        While bEnde = False
          l = InStr(lPos, sText, vbCrLf)
          If l > 0 Then
            If l - lPos >= MAX_CHAR_COUNT Then
              .SelStart = lPos + (MAX_CHAR_COUNT - 1)
              .SelLength = l - lPos - MAX_CHAR_COUNT
              .SelColor = vbBlue
            End If
          Else
            bEnde = True
          End If
          lPos = lPos + (l - lPos) + 2
        Wend
 
        .Enabled = True
 
    End With
 
End Sub
 
Private Sub cmdSaveFile_Click()
 
    With CommonDialog1
        If Dir(.FileName) <> "" Then
            RichTextBox1.SaveFile .FileName, rtfCFText
        End If
    End With
 
End Sub
 
Private Sub RichTextBox1_Change()
 
    Dim lngLine As Long
    Dim lngCursorPos As Long
    Dim lngFirstChar As Long
    Dim lngLineLength As Long
    Dim lngCurPos As Long
        lngCurPos = GetCurPos(RichTextBox1, lngLine, lngCursorPos, _
          lngFirstChar, lngLineLength)
 
    Dim lngSelStart As Long
        lngSelStart = RichTextBox1.SelStart
 
        RichTextBox1.SelStart = lngFirstChar
        RichTextBox1.SelLength = lngLineLength
        RichTextBox1.SelColor = vbBlack
        RichTextBox1.SelStart = lngSelStart
 
        If lngLineLength > MAX_CHAR_COUNT Then
            RichTextBox1.SelStart = lngFirstChar + MAX_CHAR_COUNT
            RichTextBox1.SelLength = lngLineLength - MAX_CHAR_COUNT
            RichTextBox1.SelColor = vbRed
            RichTextBox1.SelStart = lngSelStart
        End If
 
End Sub

Mit freundlichen Gr??en,
Andy G.