Notepad ++

AddColorWord "<a href="URL"></a>", RGB(100, 25, 255)

AddColorWord "<a href = " & ">", RGB(100, 25, 255)

AddColorRange "<a href=", ">", vbGreen

Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_EX_CLIENTEDGE = &H200
Private Const SCI_START = 2000
Private Const SCI_ADDTEXT = SCI_START + 1
Private Const SCI_SETSELBACK = SCI_START + 68
Private Declare Function CreateWindowEx Lib "USER32" _
    Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String, _
    ByVal dwStyle As Long, ByVal x As Long, _
    ByVal y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hWndParent As Long, _
    ByVal hMenu As Long, ByVal hInstance As Long, _
    lpParam As Any) As Long
Private Declare Function LoadLibrary Lib "Kernel32" _
    Alias "LoadLibraryA" (ByVal lpLibFileName As String) _
    As Integer
Private Declare Function SendMessage Lib "USER32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal msg As Long, ByVal wp As Long, _
    ByVal lp As Long) As Long
Private Declare Function SendMessageString Lib "USER32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal msg As Long, ByVal wp As Long, _
    ByVal lp As Any) As Long
Private Declare Function SetWindowPos Lib "USER32" _
    (ByVal hWnd As Long, ByVal m As Long, _
    ByVal left As Long, ByVal top As Long, _
    ByVal width As Long, ByVal height As Long, _
    ByVal flags As Long) As Long
Dim sci As Long
 
Private Sub Form_Load()
    LoadLibrary ("SciLexer.DLL")
    sci = CreateWindowEx(WS_EX_CLIENTEDGE, "Scintilla", _
        "TEST", WS_CHILD Or WS_VISIBLE, 0, 0, 200, 200, _
        Form1.hWnd, 0, App.hInstance, 0)
    SendMessage sci, SCI_SETSELBACK, 1, &HFFEFD0
    SendMessageString sci, SCI_ADDTEXT, 16, "Hello non-Python"
End Sub
 
Private Sub Form_Resize()
    SetWindowPos sci, 0, 2, 2, Form1.width / 15 - 12, _
        Form1.height / 15 - 30, 0
End Sub

Private Sub ColorTags(rch As RichTextBox)
Dim txt As String
Dim tag_open As Integer
Dim tag_close As Integer
 
    txt = rch.Text
    tag_close = 1
    Do
        ' See where the next tag starts.
        tag_open = InStr(tag_close, txt, "<")
        If tag_open = 0 Then Exit Do
       
        ' See where the tag ends.
        tag_close = InStr(tag_open, txt, ">")
        If tag_open = 0 Then tag_close = Len(txt)
       
        ' Color the tag.
        rch.SelStart = tag_open - 1
        rch.SelLength = tag_close - tag_open + 1
        rch.SelColor = vbRed
    Loop
End Sub
 
' Load the file.
Private Sub Form_Load()
Dim fnum As Integer
Dim txt As String
 
    ' Move the hidden text box so it cannot be seen.
    rchHidden.Move -rchHidden.Width - 120, 0
   
    ' Load the file.
    fnum = FreeFile
    Open App.Path & " odbooks.htm" For Input As fnum
    txt = Input$(LOF(fnum), fnum)
    rchHidden.Text = txt
    Close fnum
 
    ' Color the HTML tags.
    ColorTags rchHidden
 
    ' Copy the result to the visible text box.
    rchHidden.SelStart = 0
    rchHidden.SelLength = Len(rchHidden.Text)
    rchVisible.SelStart = 0
    rchVisible.SelLength = Len(rchVisible.Text)
    rchVisible.SelRTF = rchHidden.SelRTF
End Sub
Private Sub Form_Resize()
    rchVisible.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Option Explicit
 
'Scintilla
 
'Private Const WS_CHILD = &H40000000
'Private Const WS_VISIBLE = &H10000000
'Private Const WS_EX_CLIENTEDGE = &H200
'Private Const SCI_START = 2000
'Private Const SCI_ADDTEXT = SCI_START + 1
'Private Const SCI_SETSELBACK = SCI_START + 68
'Private Declare Function CreateWindowEx Lib "USER32" _
    Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String, _
    ByVal dwStyle As Long, ByVal x As Long, _
    ByVal y As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hWndParent As Long, _
    ByVal hMenu As Long, ByVal hInstance As Long, _
    lpParam As Any) As Long
'Private Declare Function LoadLibrary Lib "Kernel32" _
    Alias "LoadLibraryA" (ByVal lpLibFileName As String) _
    As Integer
'Private Declare Function SendMessage Lib "USER32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal msg As Long, ByVal wp As Long, _
    ByVal lp As Long) As Long
'Private Declare Function SendMessageString Lib "USER32" _
    Alias "SendMessageA" (ByVal hWnd As Long, _
    ByVal msg As Long, ByVal wp As Long, _
    ByVal lp As Any) As Long
'Private Declare Function SetWindowPos Lib "USER32" _
    (ByVal hWnd As Long, ByVal m As Long, _
    ByVal left As Long, ByVal top As Long, _
    ByVal width As Long, ByVal height As Long, _
    ByVal flags As Long) As Long
'Dim sci As Long
'//////////////////////////////////////////////////////////////
 
Private Type RECT
        left    As Long
        top     As Long
        Right   As Long
        Bottom  As Long
End Type
 
Private Declare Function MoveWindow Lib "USER32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetClientRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
 
Private Sub Form_Load()
 
'Scintilla
'LoadLibrary ("SciLexer.DLL")
'   sci = CreateWindowEx(WS_EX_CLIENTEDGE, "Scintilla", _
        "TEST", WS_CHILD Or WS_VISIBLE, 0, 0, 200, 200, _
        Form1.hWnd, 0, App.hInstance, 0)
'    SendMessage sci, SCI_SETSELBACK, 1, &HFFEFD0
'    SendMessageString sci, SCI_ADDTEXT, 16, "Hello non-Python"
'/////////////////////////////////////////////////////////////////////
 
Dim s As String
 
CreateColorTextBox Text1, Me
 
' Îñíîâíûå òåãè è èõ àòðèáóòû
AddColorWord "<html>", vbBlue
AddColorWord "</html>", vbBlue
AddColorWord "<head>", vbBlue
AddColorWord "</head>", vbBlue
AddColorWord "<body>", vbBlue
AddColorWord "</body>", vbBlue
AddColorRange "<base", ">", vbBlue
AddColorRange "<meta", ">", vbBlue
AddColorWord "<title>", vbBlue
AddColorWord "</title>", vbBlue
 
'Òàáëèöà
AddColorRange "<table", ">", vbBlue
AddColorRange "<td", ">", vbBlue
AddColorRange "<tr", ">", vbBlue
AddColorWord "</table>", vbBlue
AddColorWord "</td>", vbBlue
AddColorWord "</tr>", vbBlue
AddColorWord "</th>", vbBlue
AddColorWord "<th>", vbBlue
 
' Òåãè ôîðìàòèðîâàíèÿ òåêñòà
AddColorWord "<pre>", vbGreen
AddColorWord "</pre>", vbGreen
AddColorWord "</h1>", vbGreen
AddColorWord "<h1>", vbGreen
AddColorWord "</h2>", vbGreen
AddColorWord "<h2>", vbGreen
AddColorWord "</h3>", vbGreen
AddColorWord "<h3>", vbGreen
AddColorWord "</h4>", vbGreen
AddColorWord "<h4>", vbGreen
AddColorWord "</h5>", vbGreen
AddColorWord "<h5>", vbGreen
AddColorWord "</h6>", vbGreen
AddColorWord "<h6>", vbGreen
AddColorWord "</b>", vbGreen
AddColorWord "<b>", vbGreen
AddColorWord "</i>", vbGreen
AddColorWord "<i>", vbGreen
AddColorWord "</tt>", vbGreen
AddColorWord "<tt>", vbGreen
AddColorWord "</kbd>", vbGreen
AddColorWord "<kbd>", vbGreen
AddColorWord "</var>", vbGreen
AddColorWord "<var>", vbGreen
AddColorWord "</em>", vbGreen
AddColorWord "<em>", vbGreen
AddColorWord "</font>", vbGreen
AddColorRange "<font", ">", vbGreen
 
' Ãèïïåðññûëêè
AddColorRange "<a", ">", vbRed
AddColorWord "</a>", vbRed
AddColorRange "<atarget", ">", vbRed
AddColorRange "<link", ">", vbRed
 
' Ôîðìàòèðîâàíèå
AddColorWord "<p>", RGB(100, 25, 255)
AddColorWord "</p>", RGB(100, 25, 255)
AddColorWord "<wbr>", RGB(100, 25, 255)
AddColorWord "<br>", RGB(100, 25, 255)
AddColorWord "</ol>", RGB(100, 25, 255)
AddColorWord "<ol>", RGB(100, 25, 255)
AddColorWord "<li>", RGB(100, 25, 255)
AddColorWord "</ul>", RGB(100, 25, 255)
AddColorWord "<ul>", RGB(100, 25, 255)
AddColorRange "<div", ">", RGB(100, 25, 255)
 
'Ãðàôè÷åñêèå ýëåìåíòû
AddColorRange "<img", ">", 817920
AddColorRange "<hr", ">", 817920
 
'Ôðåéìû
AddColorRange "<frameset", ">", vbRed
AddColorRange "<noframes", ">", vbRed
AddColorWord "</frameset>", vbRed
AddColorWord "</noframes>", vbRed
AddColorWord "<frame>", vbRed
AddColorRange "<iframe", ">", vbRed
 
'Ôîðìû
AddColorWord "<form>", RGB(300, 25, 255)
AddColorWord "</form>", RGB(300, 25, 255)
AddColorWord "<option>", RGB(300, 25, 255)
AddColorRange "<textarea", ">", RGB(300, 25, 255)
AddColorRange "<input", ">", RGB(300, 25, 255)
 
'Âñå,÷òî çà ' è "
AddColorRange "'", Chr(0), 9605778
AddColorRange """", """", vbMagenta
 
Text1.Text = s
End Sub
Sub Red(moya_funczia As String)
  AddColorWord moya_funczia, vbRed
End Sub
 
Private Sub Form_Resize()
'Scintilla
    'SetWindowPos sci, 0, 2, 2, Form1.width / 15 - 12, _
        Form1.height / 15 - 30, 0
'////////////////////////////////////////////////////////////
 
Dim R As RECT
GetClientRect Me.hWnd, R
MoveWindow Text1.hWnd, 0, 0, R.Right, R.Bottom, True
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    DestroyColorTextBox
End Sub

Option Explicit
 
Private Type TColorWord
    Word        As String
    Color       As Long
End Type
 
Private Type TColorRange
    StartString   As String
    StopString    As String
    Color       As Long
End Type
 
Private Type POINTAPI
        x       As Long
        y       As Long
End Type
 
Private Type RECT
        left    As Long
        top     As Long
        Right   As Long
        Bottom  As Long
End Type
 
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetKeyState Lib "USER32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
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 SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpPoint As Any) As Long
Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function MulDiv Lib "Kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
Private Declare Function HideCaret Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function ShowCaret Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetSysColor Lib "USER32" (ByVal nIndex As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
 
Private Const GWL_WNDPROC = (-4), _
              WM_PAINT = &HF, _
              WM_MOUSEMOVE = &H200, _
              MK_LBUTTON = &H1, _
              WM_LBUTTONUP = &H202, _
              WM_PASTE = &H302, _
              WM_KILLFOCUS = &H8, _
              WM_SETFOCUS = &H7, _
              WM_HSCROLL = &H114, _
              WM_VSCROLL = &H115, _
              WM_MOUSEWHEEL = &H20A, _
              SB_ENDSCROLL = 8, _
              WM_KEYDOWN = &H100, _
              VK_BACK = &H8, _
              VK_TAB = &H9, _
              WM_CHAR = &H102, _
              VK_SHIFT = &H10, _
              EM_POSFROMCHAR = &HD6
Private Const EM_LINEFROMCHAR = &HC9, _
              WM_GETFONT = &H31, _
              EM_LINEINDEX = &HBB, _
              EM_LINELENGTH = &HC1, _
              EM_GETLINE = &HC4, _
              EM_CHARFROMPOS = &HD7, _
              EM_GETFIRSTVISIBLELINE = &HCE, _
              EM_GETRECT = &HB2, _
              PS_SOLID = 0, _
              DEFAULT_CHARSET = 1, _
              LOGPIXELSY = 90, _
              OUT_DEFAULT_PRECIS = 0, _
              CLIP_DEFAULT_PRECIS = 0, _
              DEFAULT_PITCH = 0, _
              FW_NORMAL = 400, _
              DEFAULT_QUALITY = 0, _
              WM_SETFONT = &H30, _
              COLOR_HIGHLIGHT = 13, _
              COLOR_HIGHLIGHTTEXT = 14, _
              COLOR_BTNFACE = 15, _
              EM_GETLINECOUNT = &HBA
 
Public PrevProc                 As Long
 
Private ColorTextBox            As TextBox, _
        ColorTextBoxParentForm  As Form, _
        CWord()                 As TColorWord, _
        CRange()                As TColorRange, _
        TexthDC                 As Long, _
        hFont                   As Long, _
        hPen                    As Long, _
        CharHeight              As Long, _
        CharWidth               As Long, _
        HLColor                 As Long, _
        NColor                  As Long, _
        HLTextColor             As Long, _
        NTextColor              As Long, _
        CurrentBkColor          As Long, _
        CurrentTextColor        As Long, _
        CColor                  As Long, _
        CTextColor              As Long
 
Private Sub PrepareTextBox()
Dim FontHeight As Long
ColorTextBox.ForeColor = vbBlack
ColorTextBox.BackColor = vbWhite
FontHeight = -MulDiv(10, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72)
hFont = CreateFont(FontHeight, 0, 0, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, "courier new")
SendMessage ColorTextBox.hWnd, WM_SETFONT, hFont, 0
TexthDC = GetDC(ColorTextBox.hWnd)
SelectObject TexthDC, hFont
hPen = CreatePen(PS_SOLID, 0, ColorTextBox.BackColor)
SelectObject TexthDC, hPen
End Sub
 
Private Sub PrepareVars()
Dim Size As POINTAPI
ReDim CWord(0)
ReDim CRange(0)
GetTextExtentPoint32 TexthDC, "x", 1, Size
CharHeight = Size.y: CharWidth = Size.x
HLColor = GetSysColor(COLOR_HIGHLIGHT)
HLTextColor = GetSysColor(COLOR_HIGHLIGHTTEXT)
NColor = ColorTextBox.BackColor
NTextColor = vbBlue
CColor = ColorTextBox.BackColor
CTextColor = ColorTextBox.ForeColor
CurrentTextColor = 1
End Sub
 
Public Sub AddColorWord(Word As String, Color As Long)
Dim i As Long
For i = 0 To UBound(CWord)
    If CWord(i).Word = "" Or UCase(CWord(i).Word) = UCase(Word) Then
        With CWord(i)
            .Word = Word
            .Color = Color
        End With
        Exit Sub
    End If
Next i
ReDim Preserve CWord(UBound(CWord) + 1)
With CWord(UBound(CWord))
    .Word = Word
    .Color = Color
End With
End Sub
 
Public Sub DeleteColorWord(Word As String)
Dim i As Long
For i = 0 To UBound(CWord)
    If UCase(CWord(i).Word) = UCase(Word) Then CWord(i).Word = ""
Next i
End Sub
 
Public Sub AddColorRange(StartString As String, StopString As String, Color As Long)
Dim i As Long
For i = 0 To UBound(CRange)
    If CRange(i).StartString = "" Or UCase(CRange(i).StartString) = UCase(StartString) Then
        With CRange(i)
            .StartString = StartString
            .StopString = StopString
            .Color = Color
        End With
        Exit Sub
    End If
Next i
ReDim Preserve CRange(UBound(CRange) + 1)
With CRange(UBound(CRange))
    .StartString = StartString
    .StopString = StopString
    .Color = Color
End With
End Sub
 
Public Sub DeleteColorRange(StartString As String)
Dim i As Long
For i = 0 To UBound(CRange)
    If UCase(CRange(i).StartString) = UCase(StartString) Then CRange(i).StartString = ""
Next i
End Sub
 
Private Sub PaintLine(LineIndex As Long, Selected As Boolean)
Dim s               As String, _
    ss              As String, _
    Chp             As Long, _
    Chp2            As Long, _
    MinChp          As Long, _
    MinChpIndex     As Long, _
    m               As Long, _
    x               As Long, _
    y               As Long, _
    SChp            As Long, _
    PosFromChar     As Long, _
    chIndex         As Long, _
    SelLength       As Long, _
    i               As Long, _
    SelStart        As Long, _
    n               As Long, _
    OK              As Boolean, _
    WordForOut      As String, _
    CW              As Boolean, _
    WordForFinding  As String
SelStart = ColorTextBox.SelStart
SelLength = ColorTextBox.SelLength
chIndex = SendMessage(ColorTextBox.hWnd, EM_LINEINDEX, LineIndex, 0&)
s = Space(SendMessage(ColorTextBox.hWnd, EM_LINELENGTH, chIndex, 0&))
SendMessage ColorTextBox.hWnd, EM_GETLINE, LineIndex, ByVal s
HideCaret ColorTextBox.hWnd
CW = True
Do
    If CW Then WordForFinding = CWord(n).Word
    If WordForFinding <> "" Or Not CW Then
        Do
            OK = True
            If CW Then
                Chp = InStr(Chp + 1, UCase(s), UCase(WordForFinding))
                If Chp = 0 Then Exit Do
                If Chp = 1 Then
                    OK = True
                Else
                    If Mid(s, Chp - 1, 1) = " " Then
                        OK = True
                    Else
                        OK = False
                    End If
                End If
                If OK And Chp + Len(WordForFinding) - 1 <> Len(s) Then
                    ss = Mid(s, Chp + Len(WordForFinding), 1)
                    If ss <> " " And ss <> "," And ss <> "(" And ss <> ")" Then OK = False
                End If
            Else
                MinChpIndex = -1
                MinChp = Len(s)
                For m = 0 To UBound(CRange)
                    x = InStr(Chp2 + 1, UCase(s), UCase(CRange(m).StartString))
                    y = IIf(CRange(m).StopString <> Chr(0), InStr(x + 1, UCase(s), UCase(CRange(m).StopString)), Len(s))
                    If x <> 0 And x < MinChp And y <> 0 Then
                        MinChp = x
                        MinChpIndex = m
                        SChp = y
                    End If
                Next m
                If MinChpIndex <> -1 Then
                    Chp = MinChp
                    Chp2 = SChp
                    OK = True
                Else
                    Exit Do
                End If
            End If
            If OK Then
                If CW Then
                    NTextColor = CWord(n).Color
                    WordForOut = WordForFinding
                Else
                    NTextColor = CRange(MinChpIndex).Color
                    WordForOut = Mid(s, Chp, Chp2 - Chp + 1)
                End If
                PosFromChar = SendMessage(ColorTextBox.hWnd, EM_POSFROMCHAR, chIndex + Chp - 1, 1)
                'åñëè ñëîâî íå âûäåëåíî:
                If chIndex + Chp - 1 > SelStart + SelLength Or chIndex + Chp - 1 + Len(WordForOut) < SelStart Or Not Selected Then
                    If CurrentTextColor <> NTextColor Then
                        SetBkColor TexthDC, NColor
                        SetTextColor TexthDC, NTextColor
                        CurrentTextColor = NTextColor
                    End If
                    TextOut TexthDC, LoWord(PosFromChar), HiWord(PosFromChar), WordForOut, Len(WordForOut)
                Else
                    'åñëè âñ¸ ñëîâî âûäåëåíî:
                    If (chIndex + Chp - 1) >= SelStart And (chIndex + Chp - 1 + Len(WordForOut)) <= (SelStart + SelLength) Then
                        If CurrentTextColor <> HLTextColor Then
                            SetBkColor TexthDC, HLColor
                            SetTextColor TexthDC, HLTextColor
                            CurrentTextColor = HLTextColor
                        End If
                        TextOut TexthDC, LoWord(PosFromChar), HiWord(PosFromChar), WordForOut, Len(WordForOut)
                    Else
                        'ïîëñëîâà âûäåëåíî, à ïîëñëîâà íåò
                        For i = chIndex + Chp - 1 To chIndex + Chp - 1 + Len(WordForOut) - 1
                            If i >= SelStart And i < SelStart + SelLength Then
                                If CurrentTextColor <> HLTextColor Then
                                    SetBkColor TexthDC, HLColor
                                    SetTextColor TexthDC, HLTextColor
                                    CurrentTextColor = HLTextColor
                                End If
                            Else
                                If CurrentTextColor <> NTextColor Then
                                    SetBkColor TexthDC, NColor
                                    SetTextColor TexthDC, NTextColor
                                    CurrentTextColor = NTextColor
                                End If
                            End If
                            TextOut TexthDC, LoWord(PosFromChar) + (i - (chIndex + Chp - 1)) * CharWidth, HiWord(PosFromChar), Mid(WordForOut, i - (chIndex + Chp - 1) + 1, 1), 1
                        Next i
                    End If
                End If
            End If
        Loop
    End If
    n = n + 1
    If Not CW Then Exit Do
    If CW And n > UBound(CWord) Then CW = False
Loop
ShowCaret ColorTextBox.hWnd
End Sub
 
Public Sub CreateColorTextBox(TextBox As TextBox, ParentForm As Form)
Set ColorTextBox = TextBox
Set ColorTextBoxParentForm = ParentForm
PrepareTextBox
PrepareVars
HookTextBox
End Sub
 
Public Sub DestroyColorTextBox()
UnHookTextBox
ReDim CWord(0)
ReDim CRange(0)
ReleaseDC ColorTextBox.hWnd, TexthDC
DeleteObject hPen
ColorTextBox.Refresh
Set ColorTextBox = Nothing
Set ColorTextBoxParentForm = Nothing
End Sub
 
Private Sub HookTextBox()
PrevProc = SetWindowLong(ColorTextBox.hWnd, GWL_WNDPROC, AddressOf TextBoxWindowProc)
End Sub
 
Private Sub UnHookTextBox()
SetWindowLong ColorTextBox.hWnd, GWL_WNDPROC, PrevProc
End Sub
 
Public Function TextBoxWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim ReDraw As Boolean
If uMsg = WM_CHAR And wParam = VK_BACK Then
    If Back_Pressed Then
        uMsg = 0
        ReDraw = True
    End If
End If
If uMsg = WM_CHAR And wParam = VK_TAB Then
    If (GetKeyState(VK_SHIFT) And &HF0000000) Then
        ShiftTab_Pressed
    Else
        Tab_Pressed
    End If
    uMsg = 0
    ReDraw = True
End If
 
TextBoxWindowProc = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
If uMsg = WM_CHAR Then DrawCurrentLine
If uMsg = WM_PAINT _
   Or uMsg = WM_LBUTTONUP _
   Or uMsg = WM_PASTE _
   Or (uMsg = WM_MOUSEMOVE And wParam = MK_LBUTTON) _
   Or uMsg = WM_SETFOCUS _
   Or uMsg = WM_KILLFOCUS _
   Or ReDraw _
   Or uMsg = WM_KEYDOWN _
   Or uMsg = WM_CHAR _
Then PaintAllLines uMsg <> WM_KILLFOCUS
If uMsg = WM_KILLFOCUS Then SetTabStop True
If uMsg = WM_SETFOCUS Then SetTabStop False
If ((uMsg = WM_HSCROLL Or uMsg = WM_VSCROLL) And LoWord(wParam) = SB_ENDSCROLL) Or uMsg = WM_MOUSEWHEEL Then DrawVLines
End Function
 
Public Function LoWord(DWord As Long) As Integer
LoWord = IIf(DWord And &H8000&, DWord Or &HFFFF0000, DWord And &HFFFF&)
End Function
 
Public Function HiWord(DWord As Long) As Integer
HiWord = (DWord And &HFFFF0000) \ &H10000
End Function
 
Private Sub PaintAllLines(Selected As Boolean)
Dim FirstVisibleLine    As Long, _
    VisibleLineCount    As Long, _
    R                   As RECT, _
    i                   As Long, _
    LineCount           As Long
LineCount = SendMessage(ColorTextBox.hWnd, EM_GETLINECOUNT, 0, 0)
FirstVisibleLine = SendMessage(ColorTextBox.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0)
SendMessage ColorTextBox.hWnd, EM_GETRECT, 0, R
VisibleLineCount = Int((R.Bottom - R.top) / CharHeight)
Debug.Print CStr(VisibleLineCount)
For i = FirstVisibleLine To FirstVisibleLine + VisibleLineCount
    If i >= VisibleLineCount + FirstVisibleLine Then Exit For
    PaintLine i, Selected
Next i
End Sub
 
Private Sub DrawLine(LineIndex As Long)
Dim s           As String, _
    PosFromChar As Long, _
    chIndex     As Long
chIndex = SendMessage(ColorTextBox.hWnd, EM_LINEINDEX, LineIndex, 0&)
s = Space(SendMessage(ColorTextBox.hWnd, EM_LINELENGTH, chIndex, 0&))
SendMessage ColorTextBox.hWnd, EM_GETLINE, LineIndex, ByVal s
HideCaret ColorTextBox.hWnd
PosFromChar = SendMessage(ColorTextBox.hWnd, EM_POSFROMCHAR, chIndex, 1)
If CurrentTextColor <> CTextColor Then
    SetBkColor TexthDC, CColor
    SetTextColor TexthDC, CTextColor
    CurrentTextColor = CTextColor
End If
TextOut TexthDC, Lo