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

'Public TextLine As New Collection

'Private Type RECT
'    Left As Long
'    Top As Long
'    Right As Long
'    Bottom As Long
'End Type

'Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
'Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
'Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
'Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
'Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
'Private Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, col As Long) As Long
'Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
'Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
'Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Obj As PictureBox
Private ScrL As Object
Private InstOK As Boolean

Public fColor As Long
Public bColor As Long
Public Underlined As Boolean
Public LastScrPos As Integer

Public ScrollState As Integer
Public LineCount As Integer

Public SelledText As String
Public SelledTextEx As String
Public Trigger As Long
Public TriggerStr As String

Public lX As Single
Public lY As Single
Public lButton As Integer

Private mBrush As Long
Private cx As Single
Private cy As Single
Private StartCX As Single
Private StartCY As Single
Private CButton As Integer
Private CShift As Integer

Private LineIndex() As Long
Private LineIndexPos As Integer
Private LinePartI() As Long
Private LinePartIPos As Long
Private TextBuffer As String
Private BufferPos As Double

Private PosOfLine As Long
Private PosInLine As Long
Private THeight As Integer

Private FildLine As Long
Private RedLine As Boolean
Private NoRefresh As Boolean
Private TriggerPass As Boolean
Private LIconIndex As Long
Private LNextDivLine As Long
Private ShiftIN As Long
Private ShowTime As Boolean
Private ShowTimeStatic As Boolean
Private RightStart As Long
Private MaxLines As Long
Private LastSearchText As String

Const LINESPACE  As Integer = 3
Const PART_LINES As Integer = 128

Const TEXT_BUFF_INCR = 16384 ' 16 kByte

Const TEXT_RIN = 4
Const TEXT_EBG = 32
Const TEXT_TEXTRIGHT = 24
Const TEXT_RUECKIN = 32

Private TriggerArr(1 To 32) As String * 256
Private TriggerArrI As Integer

Event Click(Button As Integer)
Event DblClick(Button As Integer)
Event Trigger(TriggerID As Long, TriggerStr As String, Text As String, Button As Integer, FirstLinePart As String)
Event NoTrigger(Button As Integer)

Private Function AddTriggStr(TriggStr As String) As Integer
  If Len(TriggStr) > 256 Or Len(TriggStr) = 0 Then Exit Function
  TriggerArrI = TriggerArrI + 1
  If TriggerArrI > UBound(TriggerArr) Then TriggerArrI = 1
  TriggerArr(TriggerArrI) = TriggStr
  AddTriggStr = TriggerArrI
End Function

Public Sub SetLineIcon(IconIndex As Long)
  LIconIndex = IconIndex
End Sub

Public Sub SetDivLine(Color As Long)
  LNextDivLine = Color
End Sub

Public Sub SetShowTime(Activ As Boolean, Optional Refresh As Boolean, Optional StaticVal As Boolean)
  If StaticVal Or ShowTimeStatic = False Then
    ShowTimeStatic = StaticVal
    ShowTime = Activ
    If ShowTime Then
      RightStart = Obj.TextWidth("00:00") + 10
    Else
      RightStart = 0
    End If
    If Refresh Then RefText False
  End If
End Sub

Public Sub SetShiftIn(Activ As Boolean)
  If Activ Then ShiftIN = TEXT_EBG Else ShiftIN = TEXT_RIN + 1
End Sub

Public Sub PrText(Text As String, Optional NewLine As Boolean = True)
  Dim I As Long
  Dim DAT As String
  
  If Len(Text) = 0 Then Exit Sub
  DAT = Text
  I = 0
  Do
    I = InStr(I + 1, DAT, Chr(10))
    If I > 0 Then Mid(DAT, I, 1) = " "
  Loop Until I = 0
  I = 0
  Do
    I = InStr(I + 1, DAT, Chr(13))
    If I > 0 Then Mid(DAT, I, 1) = " "
  Loop Until I = 0
  
  LinePartIPos = LinePartIPos + 1
  If LinePartIPos > UBound(LinePartI, 2) Then ReDim Preserve LinePartI(5, 1 To LinePartIPos + MaxLines - 1)
  If NewLine = True Or LineIndexPos = 0 Then
    LineIndexPos = LineIndexPos + 1
    If LinePartIPos > CLng(MaxLines) * PART_LINES Then LinePartIPos = 1
    If LineIndexPos > MaxLines Then LineIndexPos = 1: LineCount = MaxLines
    If MaxLines > LineCount Then LineCount = LineIndexPos
    If LineIndexPos > UBound(LineIndex, 2) Then ReDim Preserve LineIndex(2, 1 To LineIndexPos + MaxLines - 1)
    LineIndex(0, LineIndexPos) = LinePartIPos
    LineIndex(1, LineIndexPos) = 1
    LineIndex(2, LineIndexPos) = LIconIndex
    LineIndex(3, LineIndexPos) = LNextDivLine: LNextDivLine = 0
    If LIconIndex > 0 Then
      LineIndex(4, LineIndexPos) = ShiftIN + 8
      LIconIndex = 0
    Else
      LineIndex(4, LineIndexPos) = ShiftIN
    End If
    LineIndex(5, LineIndexPos) = Timer
    If LineCount = MaxLines And ScrL.Value > 1 And FrontCFrame.TextF Is Me Then
      NoRefresh = True
      ScrL.Value = ScrL.Value - 1
      NoRefresh = False
    End If
  Else
    LineIndex(1, LineIndexPos) = LinePartIPos - LineIndex(0, LineIndexPos) + 1
  End If
  If BufferPos + 1 + Len(DAT) > Len(TextBuffer) Then TextBuffer = TextBuffer + String(TEXT_BUFF_INCR, Chr(0))
  LinePartI(1, LinePartIPos) = Len(DAT)
  LinePartI(2, LinePartIPos) = fColor
  LinePartI(3, LinePartIPos) = bColor
  If Trigger = 0 Then
    LinePartI(4, LinePartIPos) = CInt(Underlined) * 64
  Else
    If Len(TriggerStr) Then LinePartI(5, LinePartIPos) = AddTriggStr(TriggerStr)
    LinePartI(4, LinePartIPos) = (CInt(Underlined) * 2 + 1) * Abs(Trigger)
  End If
  If BufferPos > CLng(MaxLines) * 128 Then BufferPos = 0
  LinePartI(0, LinePartIPos) = BufferPos + 1
  Mid(TextBuffer, BufferPos + 1, Len(DAT)) = DAT
  BufferPos = BufferPos + Len(DAT)
  
  If ScrL.Value + 1 < LineCount Then RedLine = True
End Sub

Public Sub RefText(Optional NoTextRefresh As Boolean)
  THeight = Obj.TextHeight("j")
  NoRefresh = True
  If ScrL.Max <> LineCount - 1 Then
    If LineCount > 1 Then ScrL.Max = LineCount - 1 Else ScrL.Max = 0
  End If
  If NoTextRefresh = False Then NoRefresh = False
  If ScrL.Value = ScrL.Max Or cx <> StartCX Or cy <> StartCY Or ScrL.Value + 3 < LineCount Then
    Refresh
  Else
    ScrL.Value = ScrL.Max
  End If
  If NoTextRefresh = True Then NoRefresh = False
End Sub

Public Sub Scroll(Optional Down As Boolean)
  If ScrL.Max = ScrL.Value Then LastScrPos = ScrL.Max: RedLine = False
  If Down = True Then
    RedLine = False
    ScrL.Max = LineCount - 1
    ScrL.Value = LineCount - 1
  Else
    If NoRefresh = False Then
      cx = 0
      cy = 0
      StartCX = 0
      StartCY = 0
      SelledText = ""
      SelledTextEx = ""
    End If
    If Form1.WindowState <> 1 And Form1.Visible = True Then Refresh
  End If
End Sub

Public Sub Inst(PictureBox As PictureBox, ScrollBar As Object, Optional MaxLineCount As Long = 16536)
  MaxLines = MaxLineCount
  ReDim LineIndex(5, 1 To MaxLines)
  ReDim LinePartI(5, 1 To MaxLines)
  Set Obj = PictureBox
  Set ScrL = ScrollBar
  ScrL.LargeChange = 10
  Obj.AutoRedraw = False
  Obj.ScaleMode = 3
  Obj.BorderStyle = 0
  cx = 0
  cy = 0
  StartCX = 0
  StartCY = 0
  InstOK = True
End Sub

Public Sub MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim I As Integer
  If Button = 1 And (cx <> 0 Or 0 <> StartCX Or cy <> 0 Or 0 <> StartCY) Then
    CButton = Button
    CShift = Shift
    cx = X
    cy = Y
    Refresh 1
    If Len(SelledText) > 0 Then Obj.MousePointer = 3
  ElseIf Button = 0 Then
    Refresh 4
  ElseIf Button > 2 Then
    If Y - lY > 0 Then
      I = ScrL.Value + ((Y - lY) ^ 2) ^ 0.6 / 3
    Else
      I = ScrL.Value + ((Y - lY) ^ 2) ^ 0.6 / -3
    End If
    If I < 0 Then I = 0
    If I > ScrL.Max - 1 Then I = ScrL.Max
    ScrL.Value = I
  End If
  lX = X
  lY = Y
End Sub

Public Sub MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  lX = X
  lY = Y
  TriggerPass = False
  If (StartCX = X And StartCY = Y And Len(SelledText) = 0) Or StartCY = 0 Then
    If StartCX = cx And StartCY = cy Then
      StartCX = 0
      StartCY = 0
      cx = 0
      cy = 0
      SelledText = ""
      SelledTextEx = ""
    End If
    If Button = 1 Then Refresh 5
    If Button = 2 Then Refresh 6
  Else
    If StartCX = cx And StartCY = cy Then
      StartCX = 0
      StartCY = 0
      cx = 0
      cy = 0
      SelledText = ""
      SelledTextEx = ""
      Refresh 1
    ElseIf Button = 1 Then
      cx = X
      cy = Y
      Refresh 1
    End If
  End If
  If TriggerPass = False Then RaiseEvent NoTrigger(Button)
  Obj.MousePointer = 0
End Sub

Public Sub MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then
    CButton = Button
    CShift = Shift
    cx = X
    cy = Y
    StartCX = X
    StartCY = Y
  End If
  lX = X
  lY = Y
  lButton = Button
End Sub

Public Sub Resize()
  cx = 0
  cy = 0
  StartCX = 0
  StartCY = 0
  If InstOK = True And Obj.ScaleHeight > 2 Then
    SetShowTime ShowTime
    ScrL.Top = 0
    ScrL.Height = Obj.ScaleHeight
    ScrL.Left = Obj.ScaleWidth - ScrL.Width
    If Fix(Obj.ScaleHeight / 16) - 4 > 0 Then ScrL.LargeChange = Fix(Obj.ScaleHeight / 16) - 4
    If ScrL.Max = ScrL.Value Then RedLine = False
    RefText True
  End If
End Sub

Public Sub Paint()
  Refresh
End Sub

Public Sub DblClick()
  RaiseEvent DblClick(lButton)
End Sub

Public Sub KeyDown(KeyCode As Integer, Shift As Integer)
  Dim I As Integer
  If KeyCode = 40 And ScrL.Value < ScrL.Max Then ScrL.Value = ScrL.Value + 1
  If KeyCode = 38 And ScrL.Value > 0 Then ScrL.Value = ScrL.Value - 1
  If KeyCode = 34 Then
    If ScrL.Value + ScrL.LargeChange < ScrL.Max Then
      ScrL.Value = ScrL.Value + ScrL.LargeChange + 1
    Else
      ScrL.Value = ScrL.Max
    End If
  End If
  If KeyCode = 33 Then
    If ScrL.Value - 2 > ScrL.LargeChange Then
      ScrL.Value = ScrL.Value - ScrL.LargeChange
    Else
      ScrL.Value = 0
    End If
  End If
End Sub

Public Sub ClearText()
  bColor = -1
  ReDim LineIndex(5, 1 To MaxLines)
  ReDim LinePartI(5, 1 To MaxLines)
  TextBuffer = Space(8 * 1024)
  LineIndexPos = 0
  LinePartIPos = 0
  BufferPos = 0
  LineCount = 0
  SetShiftIn False
  If Form1.WindowState <> 1 And Form1.Visible = True And FrontCFrame.TextF Is Me Then RefText
End Sub

Public Sub Search(Text As String, Optional RevSearch As Boolean)
  Dim I As Long
  Dim I2 As Long
  Dim I3 As Long
  Dim I4 As Long
  Dim DAT As String
  
  If FildLine > LineCount Or FildLine < 0 Then FildLine = 0
  I = FildLine
  
  If Len(Text) > 0 Then
    If LCase(LastSearchText) <> LCase(Text) Then I = 0: FildLine = 0
    LastSearchText = Text
  End If
  If Len(LastSearchText) > 0 Then
    For I4 = 0 To LineCount
      If RevSearch Then
        I = I + 1
      Else
        I = I - 1
      End If
      If I < 1 Then I = LineCount
      If I > LineCount Then I = 1
      For I3 = LineIndex(0, I) To LineIndex(1, I) + LineIndex(0, I) - 1
        DAT = Mid(TextBuffer, LinePartI(0, I3), LinePartI(1, I3))
        If I3 > LineIndex(0, I) Then
          DAT = Mid(TextBuffer, LinePartI(0, I3 - 1), LinePartI(1, I3 - 1)) + DAT
        End If
        If InStr(1, DAT, LastSearchText, vbTextCompare) > 0 Then
          FildLine = I
          If (I - LineIndexPos + LineCount - 1) Mod LineCount > ScrL.Value Then
            ScrL.Value = (I - LineIndexPos + LineCount - 1) Mod LineCount
          End If
          If (I - LineIndexPos + LineCount - 1) Mod LineCount < ScrL.Value - 6 Then
            ScrL.Value = (I - LineIndexPos + LineCount - 1) Mod LineCount + 2
          End If
          Refresh
          Exit Sub
        End If
      Next
    Next
  End If
  Refresh
End Sub

Private Function CutStringByLen(TextStart As Long, TextLen As Long, PixelPos As Long) As Long
  Dim I As Integer
  Dim I2 As Integer
  Dim TempLen As Long
  Dim TempLen2 As Long
  For I = 1 To TextLen
    TempLen = TextWW(Mid(TextBuffer, TextStart, I), Obj.hDC)
    If PosInLine + TempLen > PixelPos Then Exit For
    I2 = I
    TempLen2 = TempLen
  Next
  CutStringByLen = I2
  PixelPos = TempLen2
End Function

Private Function GetPixelLen(TextStart As Long, TextLen As Long, PixelLen As Long, LineBeg As Long) As Long
  Dim I As Long
  Dim I2 As Long
  Dim TempLen As Long
  
  PixelLen = 0
  GetPixelLen = 0
  TempLen = TextWW(Mid(TextBuffer, TextStart, TextLen), Obj.hDC)
  If PosInLine + TempLen >= Obj.ScaleWidth - TEXT_TEXTRIGHT Then
    GetPixelLen = 64
    For I = 1 To TextLen
      Select Case AscB(Mid(TextBuffer, I + TextStart - 1, 1))
        Case 32, 45, 46, 44, 43, 95, 47, 92
          TempLen = TextWW(Mid(TextBuffer, TextStart, I), Obj.hDC)
          If PosInLine + TempLen > Obj.ScaleWidth - TEXT_TEXTRIGHT Then Exit For
          PixelLen = TempLen
          I2 = I
      End Select
    Next
  Else
    I2 = TextLen
    PixelLen = TempLen
  End If
  If I2 = 0 And (PosInLine = TEXT_RUECKIN + RightStart + LineBeg Or PosInLine = TEXT_RUECKIN + LineBeg) Then
    For I = 1 To TextLen
      TempLen = TextWW(Mid(TextBuffer, TextStart, I), Obj.hDC)
      If PosInLine + TempLen > Obj.ScaleWidth - TEXT_TEXTRIGHT Then Exit For
      PixelLen = TempLen
      I2 = I
    Next
  End If
  If I2 = 0 And (PosInLine = TEXT_RUECKIN + RightStart + LineBeg Or PosInLine = TEXT_RUECKIN + LineBeg) Then I2 = TextLen
'  If I2 = 0 Then
'    GetPixelLen = 1
'  Else
    GetPixelLen = I2
'  End If
End Function

Public Sub Refresh(Optional Mode As Integer = 0)
  Dim ICount As Integer
  Dim I As Single
  Dim I2 As Long
  Dim I3 As Long
  Dim I4 As Long
  Dim I5 As Long
  Dim I6 As Long
  Dim I7 As Long
  Dim SellHelp As String
  Dim PixelLen As Long
  Dim LastPosOfLine As Long
  Dim TextStart As Long
  Dim TextLen As Long
  Dim LastPos As Long
  Dim SellFc As Long
  Dim SellBc As Long
  Dim MouseState As Integer
  Dim sellX1 As Single
  Dim sellY1 As Single
  Dim sellX2 As Single
  Dim sellY2 As Single
    
  sellX1 = cx
  sellY1 = cy
  sellX2 = StartCX
  sellY2 = StartCY
  SortMousePos sellX1, sellY1, sellX2, sellY2
  
  If NoRefresh = True Or Obj.Visible = False Then Exit Sub
  
  If StartCY > 0 And Mode < 4 Then SelledText = "": SelledTextEx = ""
  TriggerPass = False
  TranslateColor &H8000000E, 0, SellFc
  TranslateColor &H8000000D, 0, SellBc
  PosOfLine = Obj.ScaleHeight - THeight - 3

  I = LineIndexPos + 1
  For ICount = 1 To LineCount
    I = I - 1
    If I < 1 Then I = LineCount
    If ICount > LineCount - ScrL.Value - 1 Then
      PosInLine = LineIndex(4, I) + RightStart
      I3 = 0
      For I2 = LineIndex(0, I) To LineIndex(0, I) + LineIndex(1, I) - 1
        TextStart = LinePartI(0, I2)
        TextLen = LinePartI(1, I2)
        Do
          I4 = GetPixelLen(TextStart, TextLen, PixelLen, LineIndex(4, I))
          PosInLine = PosInLine + PixelLen
          If I4 < TextLen Then
            PosInLine = LineIndex(4, I) + RightStart + TEXT_RUECKIN
            I3 = I3 + THeight
          End If
          TextLen = TextLen - I4
          TextStart = TextStart + I4
        Loop Until TextLen = 0
      Next
      
      PosOfLine = PosOfLine - I3
      PosInLine = LineIndex(4, I) + RightStart
      I3 = PosOfLine

      For I2 = LineIndex(0, I) To LineIndex(0, I) + LineIndex(1, I) - 1
        TextStart = LinePartI(0, I2)
        TextLen = LinePartI(1, I2)
        Do
          I4 = GetPixelLen(TextStart, TextLen, PixelLen, LineIndex(4, I))
          If Mode > 3 Then
            If LinePartI(4, I2) <> 0 And LinePartI(4, I2) > -64 Then
              If lY > I3 - 1 And lY < I3 + THeight + 1 And lX > PosInLine And lX < PosInLine + PixelLen Then
                MouseState = 1
                If Mode > 4 Then RaiseTrigger I2, LineIndex(0, I), Mode: Exit Sub
              End If
            End If
          Else
            If LastPos <> I3 And (sellY2 >= I3 Or sellY1 <= I3 + THeight) Then
              RedrawBG I3, THeight + LINESPACE
              LastPos = I3
              If LineIndex(2, I) > 0 Then
                If TextStart = LinePartI(0, I2) Then DrawLineSign PosInLine - 10, I3 - 4 + THeight / 2, LineIndex(2, I)
              End If
              If LineIndex(3, I) > 0 Then
                If TextStart = LinePartI(0, I2) Then
                  Obj.Line (1, I3)-(Obj.ScaleWidth - 2 - ScrL.Width, I3), CoVal.ClientMSG
                End If
              End If
            End If
            If sellY1 > 0 And ((sellY2 < I3 And sellY1 > I3 + THeight) Or _
            (cy < I3 + THeight And sellY1 > I3 And sellX1 > PosInLine + PixelLen And sellY2 < I3) Or _
            (sellY2 < I3 + THeight And sellY2 > I3 And sellX2 < PosInLine And sellY1 > I3 + THeight)) Then
              SetBkMode Obj.hDC, 2
              SetBkColor Obj.hDC, SellBc
              SetTextColor Obj.hDC, SellFc
              SellHelp = SellHelp + Mid(TextBuffer, TextStart, I4)
              I6 = 1
            Else
              If FildLine = I Then
                SetBkMode Obj.hDC, 2
                SetBkColor Obj.hDC, vbYellow
                SetTextColor Obj.hDC, vbBlack
              Else
                If LinePartI(3, I2) > -1 Then
                  SetBkMode Obj.hDC, 2
                  SetBkColor Obj.hDC, LinePartI(3, I2)
                Else
                  SetBkMode Obj.hDC, 1
                End If
                SetTextColor Obj.hDC, LinePartI(2, I2)
              End If
              I6 = 0
            End If
            If I3 > 0 Then
              TextOutW Obj.hDC, PosInLine, I3, StrPtr(Mid(TextBuffer, TextStart, I4)), I4
              If LinePartI(4, I2) < 0 Then UnderlineText PosInLine, I3, PixelLen, LinePartI(2, I2)
            End If
            If sellY1 > 0 And I3 > 0 And I6 = 0 Then
              SetBkMode Obj.hDC, 2
              SetBkColor Obj.hDC, SellBc
              SetTextColor Obj.hDC, SellFc
              If sellY1 < I3 + THeight And sellY1 > I3 And sellY2 < I3 + THeight And sellY2 > I3 Then
                I6 = sellX1
                I7 = CutStringByLen(TextStart, I4, I6)
                I6 = sellX2
                I5 = CutStringByLen(TextStart, I4, I6)
                If I7 - I5 > 0 Then
                  TextOutW Obj.hDC, PosInLine + I6, I3, StrPtr(Mid(TextBuffer, TextStart + I5, I7 - I5)), I7 - I5
                  SellHelp = SellHelp + Mid(TextBuffer, TextStart + I5, I7 - I5)
                End If
              ElseIf sellY1 < I3 + THeight And sellY1 > I3 And sellX1 < PosInLine + PixelLen Then
                I6 = sellX1
                I5 = CutStringByLen(TextStart, I4, I6)
                TextOutW Obj.hDC, PosInLine, I3, StrPtr(Mid(TextBuffer, TextStart, I5)), I5
                SellHelp = SellHelp + Mid(TextBuffer, TextStart, I5)
              ElseIf sellY2 < I3 + THeight And sellY2 > I3 And sellX2 < PosInLine + PixelLen Then
                I6 = sellX2
                I5 = CutStringByLen(TextStart, I4, I6)
                TextOutW Obj.hDC, PosInLine + I6, I3, StrPtr(Mid(TextBuffer, TextStart + I5, I4 - I5)), I4 - I5
                SellHelp = SellHelp + Mid(TextBuffer, TextStart + I5, I4 - I5)
              End If
            End If
          End If
          PosInLine = PosInLine + PixelLen
          If I4 < TextLen Then
            PosInLine = LineIndex(4, I) + RightStart + TEXT_RUECKIN
            I3 = I3 + THeight
          End If
          TextLen = TextLen - I4
          TextStart = TextStart + I4
        Loop Until TextLen = 0
      Next
      
      If PosOfLine > 0 And ShowTime And Mode < 4 Then
        SetBkMode Obj.hDC, 1
        SetTextColor Obj.hDC, CoVal.TimeStamp
        'Obj.CurrentX = 5
        'Obj.CurrentY = PosOfLine
        'Obj.Print Format(LineIndex(5, I) \ 3600, "00") + ":" + Format(LineIndex(5, I) \ 60 Mod 60, "00"), Mode
        TextOutW Obj.hDC, 5, PosOfLine, StrPtr(Format(LineIndex(5, I) \ 3600, "00") + ":" + Format(LineIndex(5, I) \ 60 Mod 60, "00")), 5
      End If
      
      If sellY1 > 0 And Mode < 4 Then
        If Len(SelledText) = 0 Then
          SelledText = SellHelp
          SelledTextEx = "(" + Format(LineIndex(5, I) \ 3600, "00") + _
          ":" + Format(LineIndex(5, I) \ 60 Mod 60, "00") + _
          ":" + Format(LineIndex(5, I) Mod 60, "00") + ")" + SellHelp
        Else
          If Len(SellHelp) > 0 Then
            SelledText = SellHelp + vbNewLine + SelledText
            SelledTextEx = "(" + Format(LineIndex(5, I) \ 3600, "00") + _
            ":" + Format(LineIndex(5, I) \ 60 Mod 60, "00") + _
            ":" + Format(LineIndex(5, I) Mod 60, "00") + ")" + SellHelp + vbNewLine + SelledTextEx
          End If
        End If
        SellHelp = ""
      End If
      
      PosOfLine = PosOfLine - THeight - LINESPACE
      If PosOfLine < -THeight Then Exit For
    End If
  Next
  
  If Mode > 3 Then
    If MouseState = 1 Then Obj.MousePointer = 99 Else Obj.MousePointer = 0
  Else
    If I < LineCount + 2 Then RedrawBG 1, PosOfLine + THeight + LINESPACE - 1
    If RedLine = True Then DrawRedLine
  End If
End Sub

Private Sub UnderlineText(TextX As Long, TextY As Long, TextPixLen As Long, Color As Long)
  Dim r As RECT
  Dim mBrush As Long
  mBrush = CreateSolidBrush(Color)
  SetRect r, TextX, TextY + THeight - 1, TextPixLen + TextX, TextY + THeight
  FillRect Obj.hDC, r, mBrush
  DeleteObject mBrush
End Sub

Private Sub RaiseTrigger(ByVal DLIndex As Long, ByVal DLEndI As Long, ByVal Mode As Integer)
  Dim TriggerID As Long
  Dim TriggerStr As String
  Dim TextLine As String
  Dim LinePart As String
  
  If Len(SelledText) = 0 Or Obj.MousePointer = 0 Then
    If LinePartI(5, DLIndex) > 0 Then
      TriggerStr = Trim(TriggerArr(LinePartI(5, DLIndex)))
    End If
    TriggerID = Abs(LinePartI(4, DLIndex))
    TextLine = Mid(TextBuffer, LinePartI(0, DLIndex), LinePartI(1, DLIndex))
    LinePart = Mid(TextBuffer, LinePartI(0, DLEndI), LinePartI(1, DLEndI) + LinePartI(1, DLEndI + 1))
    
    RaiseEvent Trigger(TriggerID, TriggerStr, TextLine, Mode - 4, LinePart)
    TriggerPass = True
  End If
End Sub

Private Sub DrawRedLine()
  Dim r As RECT
  Dim mBrush As Long
  mBrush = CreateSolidBrush(vbRed)
  SetRect r, 2, Obj.ScaleHeight - 4, Obj.ScaleWidth - 2 - ScrL.Width, Obj.ScaleHeight - 2
  FillRect Obj.hDC, r, mBrush
  DeleteObject mBrush
End Sub

Private Sub SortMousePos(MouseX As Single, MouseY As Single, StMX As Single, StMY As Single)
  Dim TempMX As Single
  Dim TempMY As Single
  If StMY > MouseY + THeight Then
    TempMY = MouseY
    MouseY = StMY
    StMY = TempMY
    TempMX = MouseX
    MouseX = StMX
    StMX = TempMX
  Else
    If StMX > MouseX And StMY > MouseY - THeight Then
      TempMX = MouseX
      MouseX = StMX
      StMX = TempMX
    End If
  End If
End Sub

Private Sub RedrawBG(ByVal Top As Long, ByVal Height As Long)
  Dim r As RECT
  Dim TColor As Long
  Dim DraWi As Long
  
  mBrush = CreateSolidBrush(Obj.BackColor)

  If HGDrawMode = 0 Then 'Garnicht
    SetRect r, 1, Top, Obj.ScaleWidth, Height + Top
  ElseIf HGDrawMode = 2 Then 'Oben Links
    If Top < Form1.BgPicture.ScaleHeight Then
      If Obj.ScaleWidth - ScrL.Width > Form1.BgPicture.ScaleWidth Then
        DraWi = Form1.BgPicture.ScaleWidth
      Else
        DraWi = Obj.ScaleWidth - ScrL.Width
      End If
      BitBlt Obj.hDC, 1, Top, DraWi, Height, Form1.BgPicture.hDC, 0, Top, vbSrcCopy
    End If
    If Top + Height < Form1.BgPicture.ScaleHeight Then
      SetRect r, Form1.BgPicture.ScaleWidth + 1, Top, Obj.ScaleWidth - ScrL.Width - 1, Height + Top
    ElseIf Top < Form1.BgPicture.ScaleHeight Then
      SetRect r, 1, Form1.BgPicture.ScaleHeight, Obj.ScaleWidth - ScrL.Width - 1, Height + Top
      FillRect Obj.hDC, r, mBrush
      SetRect r, Form1.BgPicture.ScaleWidth + 1, Top, Obj.ScaleWidth - ScrL.Width - 1, Height + Top
    Else
      SetRect r, 1, Top, Obj.ScaleWidth, Height + Top
    End If
  Else                        'Oben Rechts
    If Top < Form1.BgPicture.ScaleHeight Then
      BitBlt Obj.hDC, Obj.ScaleWidth - ScrL.Width - Form1.BgPicture.ScaleWidth, Top, _
      Form1.BgPicture.ScaleWidth, Height, Form1.BgPicture.hDC, 0, Top, vbSrcCopy
    End If
    If Top + Height < Form1.BgPicture.ScaleHeight Then
      SetRect r, 1, Top, Obj.ScaleWidth - ScrL.Width - Form1.BgPicture.ScaleWidth, Height + Top
    ElseIf Top < Form1.BgPicture.ScaleHeight Then
      SetRect r, Obj.ScaleWidth - ScrL.Width - Form1.BgPicture.ScaleWidth, Form1.BgPicture.ScaleHeight, Obj.ScaleWidth - ScrL.Width, Height + Top
      FillRect Obj.hDC, r, mBrush
      SetRect r, 1, Top, Obj.ScaleWidth - ScrL.Width - Form1.BgPicture.ScaleWidth, Height + Top
    Else
      SetRect r, 1, Top, Obj.ScaleWidth, Height + Top
    End If
  End If
  
  FillRect Obj.hDC, r, mBrush
  
  If ShowTime Then
    'DeleteObject mBrush
    'TranslateColor CoVal.BackColor, 0, TColor
    'DrawFlow Obj, RightStart - 2, Top - 1, 2, Height + 1, Form1.pTBox.BackColor, CoVal.TimeStamp, True
    'DrawFlow Obj, RightStart, Top - 1, 2, Height + 1, CoVal.TimeStamp, Form1.pTBox.BackColor, True, 200
    Obj.Line (RightStart, Top - 1)-(RightStart, Height + Top), GetMixedColor(CoVal.TimeStamp, Form1.pTBox.BackColor, 50)
    'mBrush = CreateSolidBrush(TColor)
    'SetRect r, 1, Top - 1, RightStart, Height + Top
    'FillRect Obj.hdc, r, mBrush
  End If
  
  DeleteObject mBrush
End Sub

Private Sub DrawLineSign(X As Long, Y As Long, IconIndex As Long)
  PrintIcon Obj, X, Y, IconIndex
End Sub

Public Sub ShowAsHTML(Optional FilePath As String)
  Dim FrFile As Integer
  Dim DAT As String
  Dim DAT2 As String
  Dim TextColor As String
  Dim TextBColor As String
  Dim TimeColor As String
  Dim Underlined As Boolean
  Dim Trigger As Integer
  Dim tText As String
  Dim I As Integer
  Dim I2 As Integer
  Dim I3 As Integer
  Dim St2 As Double
  Dim St3 As Double
  Dim St4 As Double
  Dim doIP As Double
  Dim SavePath As String
  
  If LineCount < 1 Then Exit Sub
  SavePath = FilePath
  If Len(SavePath) = 0 Then SavePath = UserPath + "Temp.htm"
  
  doIP = CoVal.TimeStamp
  St2 = Fix(doIP / 256 ^ 2)
  doIP = doIP - St2 * 256 ^ 2
  St3 = Fix(doIP / 256)
  doIP = doIP - St3 * 256 ^ 1
  St4 = Fix(doIP)
  TimeColor = String(2 - Len(Hex(St4)), "0") + Hex(St4) _
  + String(2 - Len(Hex(St3)), "0") + Hex(St3) _
  + String(2 - Len(Hex(St2)), "0") + Hex(St2)
  
  doIP = Form1.pTBox.BackColor
  If doIP > -1 Then
    St2 = Fix(doIP / 256 ^ 2)
    doIP = doIP - St2 * 256 ^ 2
    St3 = Fix(doIP / 256)
    doIP = doIP - St3 * 256 ^ 1
    St4 = Fix(doIP)
    TextBColor = String(2 - Len(Hex(St4)), "0") + Hex(St4) _
    + String(2 - Len(Hex(St3)), "0") + Hex(St3) _
    + String(2 - Len(Hex(St2)), "0") + Hex(St2)
  Else
    TextBColor = "FFFFFF"
  End If

  On Error Resume Next
  FrFile = FreeFile
  Open SavePath For Output As #FrFile
    Print #FrFile, "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 3.2//EN"">"
    Print #FrFile, "<html>"
    Print #FrFile, "<head>"
    Print #FrFile, "  <title>Nettalk - (" + Format(Now, "dd.mm.yyyy hh:mm:ss") + ")</title>"
    Print #FrFile, "  <style type=""text/css"">"
    Print #FrFile, "    body{ background-color:#" + TextBColor + "; font-family:" + Obj.FontName + "; font-size:" + Trim(Str(Obj.FontSize)) + "pt; }"
    Print #FrFile, "  </style>"
    Print #FrFile, "  <meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"">"
    Print #FrFile, "</head>"
    Print #FrFile, "<body>"
    I = LineIndexPos + 1
    Do
      If I > LineCount Then I = 1
      If ShowTime Then
        Print #FrFile, "<font color=""#" + TimeColor + """>" & Format(LineIndex(5, I) \ 3600, "00") + ":" + Format(LineIndex(5, I) \ 60 Mod 60, "00") & "</font>"
      End If
      For I2 = LineIndex(0, I) To LineIndex(1, I) + LineIndex(0, I) - 1
        doIP = LinePartI(2, I2)
        St2 = Fix(doIP / 256 ^ 2)
        doIP = doIP - St2 * 256 ^ 2
        St3 = Fix(doIP / 256)
        doIP = doIP - St3 * 256 ^ 1
        St4 = Fix(doIP)
        TextColor = String(2 - Len(Hex(St4)), "0") + Hex(St4) _
        + String(2 - Len(Hex(St3)), "0") + Hex(St3) _
        + String(2 - Len(Hex(St2)), "0") + Hex(St2)
        
        doIP = LinePartI(3, I2)
        If doIP > -1 Then
          St2 = Fix(doIP / 256 ^ 2)
          doIP = doIP - St2 * 256 ^ 2
          St3 = Fix(doIP / 256)
          doIP = doIP - St3 * 256 ^ 1
          St4 = Fix(doIP)
          TextBColor = " style=""background-color: #" + String(2 - Len(Hex(St4)), "0") + Hex(St4) _
          + String(2 - Len(Hex(St3)), "0") + Hex(St3) _
          + String(2 - Len(Hex(St2)), "0") + Hex(St2) + """"
        Else
          TextBColor = ""
        End If
        
        If LinePartI(4, I2) > 0 Then Underlined = False Else Underlined = True
        Trigger = Abs(LinePartI(4, I2))
        tText = EncodeUTF8(Mid(TextBuffer, LinePartI(0, I2), LinePartI(1, I2)))
        I3 = -1
        Do
          I3 = InStr(I3 + 2, tText, "  ")
          If I3 = 0 Then Exit Do
          tText = Left(tText, I3 - 1) + "&nbsp;&nbsp;" + Mid(tText, I3 + 2)
        Loop
        I3 = -1
        Do
          I3 = InStr(I3 + 2, tText, "<")
          If I3 = 0 Then Exit Do
          tText = Left(tText, I3 - 1) + "&lt;" + Mid(tText, I3 + 1)
        Loop
        I3 = -1
        Do
          I3 = InStr(I3 + 2, tText, ">")
          If I3 = 0 Then Exit Do
          tText = Left(tText, I3 - 1) + "&gt;" + Mid(tText, I3 + 1)
        Loop
        
        If Trigger = 1 Then
          If UCase(Mid(tText, 1, 7)) = "HTTP://" Then
            DAT = "<a href=""" + tText
          ElseIf UCase(Mid(tText, 1, 6)) = "FTP://" Then
            DAT = "<a href=""" + tText
          Else
            DAT = "<a href=""http://" + tText
          End If
          If Underlined = False Then DAT = DAT + " style=""text-decoration: none"""
          DAT2 = DAT2 + DAT + """><font color=""#" + TextColor + """" + TextBColor + ">" + tText + "</font></a>"
        ElseIf Trigger = 2 Then
          If UCase(Mid(tText, 1, 6)) = "DCC://" Then
            DAT = "<a href=""" + tText
          ElseIf UCase(Mid(tText, 1, 6)) = "IRC://" Then
            DAT = "<a href=""" + tText
          ElseIf UCase(Mid(tText, 1, 10)) = "NETTALK://" Then
            DAT = "<a href=""" + tText
          End If
          If Underlined = False Then DAT = DAT + " style=""text-decoration: none"""
          DAT2 = DAT2 + DAT + """><font color=""#" + TextColor + """" + TextBColor + ">" + tText + "</font></a>"
        Else
          DAT2 = DAT2 + "<font color=""#" + TextColor + """" + TextBColor + ">" + tText + "</font>"
        End If
        If Err <> 0 Then MsgBox Err.Description, vbCritical: Exit Do
      Next
      Print #FrFile, DAT2 + "<br>"
      DAT2 = ""
      If I = LineIndexPos Then Exit Do
      I = I + 1
    Loop
    Print #FrFile, "</body>"
    Print #FrFile, "</html>"
  Close #FrFile
  On Error GoTo 0
  
  If Len(FilePath) = 0 Then
    ShellExecute 0&, vbNullString, UserPath + "Temp.htm", vbNullString, vbNullString, 1
  End If
End Sub

Public Sub ShowAsTXT(Optional FilePath As String)
  Dim FrFile As Integer
  Dim DAT As String
  Dim I As Long
  Dim I2 As Long
  Dim SavePath As String
  
  If LineCount < 1 Then Exit Sub
  SavePath = FilePath
  If Len(SavePath) = 0 Then SavePath = UserPath + "Temp.txt"
  
  On Error Resume Next
  FrFile = FreeFile
  Open SavePath For Output As #FrFile
    I = LineIndexPos + 1
    Do
      If I > LineCount Then I = 1
      If ShowTime Then
        DAT = DAT + "(" + Format(LineIndex(5, I) \ 3600, "00") + ":" + Format(LineIndex(5, I) \ 60 Mod 60, "00") + ") "
      End If
      For I2 = LineIndex(0, I) To LineIndex(1, I) + LineIndex(0, I) - 1
        DAT = DAT + Mid(TextBuffer, LinePartI(0, I2), LinePartI(1, I2))
      Next
      Print #FrFile, EncodeUTF8(DAT)
      DAT = ""
      If I = LineIndexPos Then Exit Do
      I = I + 1
    Loop
  Close #FrFile
  If Err > 0 Then MsgBox Err.Description, vbCritical
  On Error GoTo 0
  
  If Len(FilePath) = 0 Then
    ShellExecute 0&, vbNullString, UserPath + "Temp.txt", vbNullString, vbNullString, 1
  End If
End Sub

Private Sub Class_Initialize()
  bColor = -1
  ScrollState = -1
  SetShiftIn False
End Sub
