[API]
RECT
DELETEITEMSTRUCT
MEASUREITEMSTRUCT
DRAWITEMSTRUCT
DrawTextW
DrawTextADirect
SetFocusAPI
SelectObject
GetSystemMetrics
GetWindowLongA
LocalAlloc
LocalFree
RtlMoveMemory
GetClientRect
SendMessageA
CreateCompatibleDC
DeleteDC
GetBkColor
GetTextColor
FillRect
GetSysColor
SetBkColor
SetTextColor
DrawIconEx
GetDlgCtrlID
GetParent
DrawFocusRect

[INCLUDE]
HookedWindowProc
WordWrapText
DrawTextGetHeight
DrawTextGetWidth
LocalAllocFromString
OSVersionDependent

[DIRECTIVE]
SetIsMinWindows982000

[DEFINE]
Private Type HyperlinkListItemStruct
  xText As Long
  LenText As Long
  LnkRect As RECT
  LnkURL As Long
  LnkCaption As Long
  LnkCapLen As Long
  xHeight As Long
  #If HyperlinkList_UseIcons Then
    hIcon As Long
    IconIdent As Long
    IconSize As Long
    #End If
  Padding As Rect
  End Type
#If HyperlinkList_UseIcons Then
  Private Const HyperlinkListItemLen As Long = 17& * 4&
  #Else
  Private Const HyperlinkListItemLen As Long = 14& * 4&
  #End If
Private Const HyperlinkList_PaddingIcon As Long = 4&

[CODE]
Private Function HyperlinkList_HitTest(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xType1 As RECT
  Dim xType2 As HyperlinkListItemStruct
        
  xLong1 = SendMessageA(hwnd, &H1A9&, 0&, ByVal lParam)
  If (xLong1 And &HFFFF0000) = 0& Then
    xLong2 = SendMessageA(hwnd, &H199&, xLong1, ByVal 0&)
    If Not xLong2 = 0& Then
      Call RtlMoveMemory(xType2, ByVal xLong2, HyperlinkListItemLen)
      If Not xType2.LnkURL = 0& Then
        If Not SendMessageA(hwnd, &H198&, xLong1, xType1) = -1& Then
          xLong1 = (lParam And &HFFFF&) - 1& ' x
          xLong2 = ((lParam And &HFFFF0000) \ &H10000) + 1& 'y
          If xLong1 > xType1.Left + xType2.LnkRect.Left + xType2.Padding.Left And xLong1 <= xType1.Left + xType2.LnkRect.Right + xType2.Padding.Left And xLong2 > xType1.Top + xType2.LnkRect.Top + xType2.Padding.Top And xLong2 <= xType1.Top + xType2.LnkRect.Bottom + xType2.Padding.Top Then
            HyperlinkList_HitTest = True
            End If
          End If
        End If
      End If
    End If
  End Function

Private Function HyperlinkList_WM_ERASEBKGND(ByVal hwnd As Long, ByVal wParam As Long) As Long
  Dim xType1 As RECT

  If Not wParam = 0& Then
    Call GetClientRect(hwnd, xType1)
    Call FillRect(wParam, xType1, 6&) '6&)
    End If
  End Function

Public Function HyperlinkList_Proc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Select Case Msg
    Case &H100&, &H101& ' WM_Key
    Case &H104&, &H105& ' WM_SKey
    Case &H102& 'WM_CHAR
      If wParam = 32& Then
        Call SendMessageA(GetParent(hwnd), &H111&, GetDlgCtrlID(hwnd) Or &H20000, ByVal hwnd)
        End If
      Exit Function
    Case &H14&
      HyperlinkList_Proc = HyperlinkList_WM_ERASEBKGND(hwnd, wParam)
      Exit Function
    Case &H200&, &H202&
      Exit Function
    Case &H201&
      If HyperlinkList_HitTest(hwnd, lParam) Then
        HyperlinkList_Proc = HookedWindowProc(hwnd, Msg, 0&, lParam)
        Call HookedWindowProc(hwnd, &H202&, 0&, lParam)
        Else
        Call SetFocusAPI(hwnd)
        End If
      Exit Function
    Case &H203&
      If HyperlinkList_HitTest(hwnd, lParam) Then
        HyperlinkList_Proc = HookedWindowProc(hwnd, Msg, 0&, lParam)
        Call HookedWindowProc(hwnd, &H200&, 0&, lParam)
        'Call HookedWindowProc(hwnd, &H203&, 0&, lParam)
        Else
        Call SetFocusAPI(hwnd)
        End If
      Exit Function
    End Select
  HyperlinkList_Proc = HookedWindowProc(hwnd, Msg, wParam, lParam)
  End Function

Public Sub HyperlinkList_AddItem(ByVal hwnd As Long, ByVal xText As String, ByRef Padding As RECT, Optional ByVal hIcon As Long, Optional ByVal IconSizeXY As Long)
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xLong3 As Long
  Dim xLong4 As Long
  Dim xLong5 As Long
  Dim xType1 As RECT
  Dim hdc As Long
  Dim hFont As Long
  Dim hFontOld As Long
  Dim xChar1 As String
  Dim xChar2 As String
  Dim xType2 As RECT

  Call GetClientRect(hwnd, xType1)
  If (GetWindowLongA(hwnd, -16&) And &H200000) = &H0& Then
    xType1.Right = xType1.Right - GetSystemMetrics(2&)
    End If

  hdc = CreateCompatibleDC(0&)
  If Not hdc = 0& Then
    hFont = SendMessageA(hwnd, &H31&, 0&, ByVal 0&)
    If Not hFont = 0& Then
      hFontOld = SelectObject(hdc, hFont)
      End If
    If hFont = 0& Or Not hFontOld = 0& Then
      xType2 = Padding
      #If HyperlinkList_UseIcons Then
        If IconSizeXY = 0& Then
          xText = WordWrapText(hdc, xText, xType1.Right - xType1.Left - Padding.Left - Padding.Right)
          Else
          xText = WordWrapText(hdc, xText, xType1.Right - xType1.Left - HyperlinkList_PaddingIcon - Padding.Left - Padding.Right - IconSizeXY)
          End If
        #Else
        xText = WordWrapText(hdc, xText, xType1.Right - xType1.Left - Padding.Left - Padding.Right)
        #End If

      xLong1 = InStr(xText, "://")
      xLong2 = InStr(xText, "@")
      If xLong2 < xLong1 And Not xLong2 = 0& Then xLong1 = xLong2
      If xLong1 = 0& Then
        #If HyperlinkList_UseIcons Then
          Call HyperlinkList_AddItemReal(hwnd, xText, DrawTextGetHeight(hdc, xText, &H510&), xType1, xType2, , , hIcon, IconSizeXY)
          #Else
          Call HyperlinkList_AddItemReal(hwnd, xText, DrawTextGetHeight(hdc, xText, &H510&), xType1, xType2)
          #End If
        Else
        xType2.Bottom = 0&
HLLoop:
        xLong2 = InStr(xLong1 + 3&, xText, "://")
        xLong5 = InStr(xLong1 + 3&, xText, "@")
        If xLong5 < xLong2 And Not xLong5 = 0& Then xLong2 = xLong5
        If Not xLong2 = 0& Then
          xLong2 = InStrRev(xText, vbCrLf, xLong2)
          End If
        If xLong2 = 0& Then
          xChar1 = xText
          xText = ""
          Else
          xChar1 = Left(xText, xLong2 - 1&)
          xText = Mid(xText, xLong2 + 2&)
          End If
    
    
        xLong2 = InStrRev(xChar1, " ", xLong1)
' <-- other begin signs ---
        xLong5 = InStrRev(xChar1, "(", xLong1)
        'If xLong5 > xLong2 And Not xLong5 = 0& Then xLong2 = xLong5
        If xLong5 > xLong2 Then xLong2 = xLong5
' --- other begin signs -->
        xLong3 = InStrRev(xChar1, vbCrLf, xLong1)
        If Not xLong3 = 0& Then xLong3 = xLong3 + 1&
        'If xLong3 > xLong2 And Not xLong3 = 0& Then xLong2 = xLong3
        If xLong3 > xLong2 Then xLong2 = xLong3
        xLong4 = InStr(xLong1, xChar1, " ")
' <-- other end signs ---
        xLong5 = InStr(xLong1, xChar1, ")")
        If xLong5 < xLong4 And Not xLong5 = 0& Then xLong4 = xLong5
' --- other end signs -->
        xLong5 = InStr(xLong1, xChar1, vbCrLf)
        If xLong5 = 0& Then xLong5 = Len(xChar1) + 1&
        If (xLong5 < xLong4 Or xLong4 = 0&) Then xLong4 = xLong5
        
        xChar2 = Left(xChar1, xLong4 - 1&)
'        Stop
        xType1.Bottom = DrawTextGetHeight(hdc, xChar2, &H510&)   ' total height
        xChar2 = Mid(xChar1, xLong3 + 1, xLong4 - xLong3 - 1)
        xType1.Right = DrawTextGetWidth(hdc, xChar2, &H510&) + 1& ' effective line total width
        xChar2 = Mid(xChar1, xLong2 + 1&, xLong4 - xLong2 - 1&)
          
        xType1.Top = xType1.Bottom - DrawTextGetHeight(hdc, xChar2, &H510&)
        xType1.Left = xType1.Right - DrawTextGetWidth(hdc, xChar2, &H510&) - 1&
          
    
        If Len(xText) = 0& Then
          xType2.Bottom = Padding.Bottom
          End If
        #If HyperlinkList_UseIcons Then
          Call HyperlinkList_AddItemReal(hwnd, xChar1, DrawTextGetHeight(hdc, xChar1, &H510&), xType1, xType2, xChar2, xChar2, hIcon, IconSizeXY)
          hIcon = 0&
          #Else
          Call HyperlinkList_AddItemReal(hwnd, xChar1, DrawTextGetHeight(hdc, xChar1, &H510&), xType1, xType2, xChar2, xChar2)
          #End If
        If Not Len(xText) = 0& Then
          xLong1 = InStr(xText, "://")
          xLong2 = InStr(xText, "@")
          If xLong2 < xLong1 And Not xLong2 = 0& Then xLong1 = xLong2
          xType2.Top = 0&
          GoTo HLLoop
          End If
        End If
      If Not hFont = 0& Then
        Call SelectObject(hdc, hFontOld)
        End If
      End If
    Call DeleteDC(hdc)
    End If
  End Sub

Public Sub HyperlinkList_AddItemReal(ByVal hwnd As Long, ByVal xText As String, ByVal xHeight As Long, ByRef LnkRect As RECT, ByRef Padding As RECT, Optional ByVal LnkURL As String, Optional ByVal LnkCaption As String, Optional ByVal hIcon As Long, Optional ByVal IconSizeXY As Long)
  Dim xLong1 As Long
  Dim xType1 As HyperlinkListItemStruct

  With xType1
    .LenText = Len(xText)
    If Not .LenText = 0& Then
      .xText = LocalAllocFromString(xText)
      End If
    If Not (Len(LnkURL) + Len(LnkCaption)) = 0& Then
      If Len(LnkCaption) = 0& Then
        LnkCaption = LnkURL
        ElseIf Len(LnkURL) = 0& Then
        LnkURL = LnkCaption
        End If
      .LnkRect = LnkRect
      .LnkURL = LocalAllocFromString(LnkURL)
      .LnkCapLen = Len(LnkCaption)
      .LnkCaption = LocalAllocFromString(LnkCaption)
      End If
    .Padding = Padding
    #If HyperlinkList_UseIcons Then
      If Not IconSizeXY = 0& Then
        If Not hIcon = 0& Then
          .hIcon = hIcon
          If IconSizeXY > xHeight Then
            xHeight = IconSizeXY
            End If
          .IconIdent = Padding.Left
          .IconSize = IconSizeXY
          End If
        .Padding.Left = Padding.Left + HyperlinkList_PaddingIcon + IconSizeXY
        End If
      #End If
    'If SendMessageA(hWnd, &H18B&, 0&, ByVal 0&) = 0& Then
      'xHeight = xHeight + HyperlinkList_PaddingT
      '.LnkRect.Top = .LnkRect.Top + HyperlinkList_PaddingT
      '.LnkRect.Bottom = .LnkRect.Bottom + HyperlinkList_PaddingT
      'End If
    .xHeight = xHeight + .Padding.Top + Padding.Bottom
    End With
  xLong1 = LocalAlloc(0&, HyperlinkListItemLen)
  If Not xLong1 = 0& Then
    Call RtlMoveMemory(ByVal xLong1, xType1, HyperlinkListItemLen)
    If Not SendMessageA(hwnd, &H180&, 0&, ByVal xLong1) < 0& Then
      GoTo Success
      End If
    Call LocalFree(xLong1)
    End If
  If Not xType1.xText = 0& Then Call LocalFree(xType1.xText)
  If Not xType1.LnkURL = 0& Then Call LocalFree(xType1.LnkURL)
  If Not xType1.LnkCaption = 0& Then Call LocalFree(xType1.LnkCaption)
Success:
  End Sub

Public Function HyperlinkList_WM_DELETEITEM(ByVal lParam As Long) As Long
  Dim xType1 As DELETEITEMSTRUCT
  Dim xType2 As HyperlinkListItemStruct
  
  If Not lParam = 0& Then
    Call RtlMoveMemory(xType1, ByVal lParam, 20&)
    If Not xType1.itemData = 0& Then
      Call RtlMoveMemory(xType2, ByVal xType1.itemData, HyperlinkListItemLen)
      If Not xType2.xText = 0& Then Call LocalFree(xType2.xText)
      If Not xType2.LnkURL = 0& Then Call LocalFree(xType2.LnkURL)
      If Not xType2.LnkCaption = 0& Then Call LocalFree(xType2.LnkCaption)
      'Stop
      Call LocalFree(xType1.itemData)
      End If
    End If
  HyperlinkList_WM_DELETEITEM = 1&
  End Function

Public Function HyperlinkList_WM_MEASUREITEM(ByVal lParam As Long) As Long
  Dim xType1 As MEASUREITEMSTRUCT
  Dim xType2 As HyperlinkListItemStruct
  
  If Not lParam = 0& Then
    Call RtlMoveMemory(xType1, ByVal lParam, 24&)
    If Not xType1.itemData = 0& Then
      Call RtlMoveMemory(xType2, ByVal xType1.itemData, HyperlinkListItemLen)
      xType1.itemHeight = xType2.xHeight
      Call RtlMoveMemory(ByVal lParam, xType1, 20&)
      End If
    End If
  HyperlinkList_WM_MEASUREITEM = 1&
  End Function

Public Function HyperlinkList_WM_DRAWITEM(ByVal lParam As Long) As Long
  Dim xType1 As DRAWITEMSTRUCT
  Dim xType2 As HyperlinkListItemStruct
  Dim xType3 As RECT
  Dim xLong1 As Long
  Dim xLong2 As Long
  
  If Not lParam = 0& Then
    Call RtlMoveMemory(xType1, ByVal lParam, 48&)
    If Not xType1.hdc = 0& Then
      
      xLong1 = GetBkColor(xType1.hdc)
      xLong2 = GetTextColor(xType1.hdc)
      Call SetBkColor(xType1.hdc, GetSysColor(5&)) '5&))
      Call FillRect(xType1.hdc, xType1.rcItem, 6&) '6&)

      If Not xType1.ItemID = -1& Then
        If Not xType1.itemData = 0& Then
          Call RtlMoveMemory(xType2, ByVal xType1.itemData, HyperlinkListItemLen)
          #If HyperlinkList_UseIcons Then
            If Not xType2.hIcon = 0& Then
              'If xType1.ItemID = 0& Then
              '  Call DrawIconEx(xType1.hdc, xType1.rcItem.Left + xType2.IconIdent, xType1.rcItem.Top + HyperlinkList_PaddingT, xType2.hIcon, xType2.IconSize, xType2.IconSize, 0&, 0&, 3&)
              '  Else
                Call DrawIconEx(xType1.hdc, xType1.rcItem.Left + xType2.IconIdent, xType1.rcItem.Top + xType2.Padding.Top, xType2.hIcon, xType2.IconSize, xType2.IconSize, 0&, 0&, 3&)
              '  End If
              End If
            #End If
          
          xType3 = xType1.rcItem
          xType1.rcItem.Left = xType1.rcItem.Left + xType2.Padding.Left ' HyperlinkList_PaddingL
          xType1.rcItem.Right = xType1.rcItem.Right - xType2.Padding.Right
          'If xType1.ItemID = 0& Then
          '  xType1.rcItem.Top = xType1.rcItem.Top + HyperlinkList_PaddingT
          '  xType1.rcItem.Bottom = xType1.rcItem.Bottom + HyperlinkList_PaddingT
          '  Else
            xType1.rcItem.Top = xType1.rcItem.Top + xType2.Padding.Top
            xType1.rcItem.Bottom = xType1.rcItem.Bottom + xType2.Padding.Top
          '  End If
          If Not xType2.xText = 0& Then
            If IsUnicode Then
              Call DrawTextW(xType1.hdc, xType2.xText, xType2.LenText, xType1.rcItem, &H110&)
              Else
              Call DrawTextADirect(xType1.hdc, xType2.xText, xType2.LenText, xType1.rcItem, &H110&)
              End If
            End If
          
          If xType2.LnkCapLen = 0& Then
            If (xType1.itemState And &H11&) And Not xType2.xText = 0& Then
              Call DrawFocusRect(xType1.hdc, xType3)
              End If
            Else
            'If xType1.ItemID = 0& Then
            '  xType1.rcItem.Top = xType1.rcItem.Top - HyperlinkList_PaddingT
            '  xType1.rcItem.Bottom = xType1.rcItem.Bottom - HyperlinkList_PaddingT
            '  End If
            xType1.rcItem.Right = xType1.rcItem.Left + xType2.LnkRect.Right
            xType1.rcItem.Left = xType1.rcItem.Left + xType2.LnkRect.Left
            xType1.rcItem.Bottom = xType1.rcItem.Top + xType2.LnkRect.Bottom
            xType1.rcItem.Top = xType1.rcItem.Top + xType2.LnkRect.Top
            
            If (xType1.itemState And &H11&) Then
              Call FillRect(xType1.hdc, xType1.rcItem, 14&)
              Call SetBkColor(xType1.hdc, GetSysColor(13&))
              Call SetTextColor(xType1.hdc, GetSysColor(14&))
              ElseIf IsMinWindows982000 Then
              Call SetTextColor(xType1.hdc, GetSysColor(26&)) '13&))
              Else
              Call SetTextColor(xType1.hdc, GetSysColor(13&)) '13&))
              End If
            If IsUnicode Then
              Call DrawTextW(xType1.hdc, xType2.LnkCaption, xType2.LnkCapLen, xType1.rcItem, &H110&)
              Else
              Call DrawTextADirect(xType1.hdc, xType2.LnkCaption, xType2.LnkCapLen, xType1.rcItem, &H110&)
              End If
            End If
          End If
        End If
      Call SetBkColor(xType1.hdc, xLong1)
      Call SetTextColor(xType1.hdc, xLong2)
      End If
    End If
  HyperlinkList_WM_DRAWITEM = 1&
  End Function
