Attribute VB_Name = "SelectionDraw"
Option Explicit

Private Enum UxThemeLISTVIEWParts
   LVP_LISTITEM = 1
   LVP_LISTGROUP = 2
   LVP_LISTDETAIL = 3
   LVP_LISTSORTEDDETAIL = 4
   LVP_EMPTYTEXT = 5
End Enum

Private Enum UxThemeLISTITEMStates
   LIS_NORMAL = 1
   LIS_HOT = 2
   LIS_SELECTED = 3
   LIS_DISABLED = 4
   LIS_SELECTEDNOTFOCUS = 5
End Enum

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

Private Declare Function DrawThemeBackground Lib "uxtheme.dll" _
   (ByVal hTheme As Long, ByVal lHDC As Long, _
    ByVal iPartId As Long, ByVal iStateId As Long, _
    pRect As RECT, pClipRect As RECT) As Long
    
Private Declare Function DrawThemeText Lib "uxtheme.dll" _
   (ByVal hTheme As Long, ByVal hDC As Long, ByVal iPartId As Long, _
    ByVal iStateId As Long, ByVal pszText As Long, _
    ByVal iCharCount As Long, ByVal dwTextFlag As Long, _
    ByVal dwTextFlags2 As Long, pRect As RECT) As Long

Private Declare Function OpenThemeData Lib "uxtheme.dll" _
   (ByVal hWnd As Long, ByVal pszClassList As Long) As Long

Private Declare Function CloseThemeData Lib "uxtheme.dll" _
   (ByVal hTheme As Long) As Long

Private Declare Function SetWindowTheme Lib "uxtheme.dll" ( _
    ByVal hWnd As Long, _
    Optional ByVal pszSubAppName As Long = 0, _
    Optional ByVal pszSubIdList As Long = 0) As Long

'Declare Function Rectangle Lib "gdi32.dll" ( _
  ByVal hDC As Long, ByVal X1 As Long, _
  ByVal Y1 As Long, ByVal X2 As Long, _
  ByVal Y2 As Long) As Long

Public SupportSelledStyle As Boolean
Private hTheme As Long
Private sClassApp As String
Private sClass As String

Public Sub InitSelectionDraw(hWnd As Long)
  Dim retVal As Long
  
  If getVersion >= 2060 Then 'Vista or newer (and Text "dark" <- ?)
    sClass = "listview"
    sClassApp = "explorer"
  
    On Error Resume Next
    retVal = SetWindowTheme(hWnd, StrPtr(sClassApp), 0)
    hTheme = OpenThemeData(hWnd, StrPtr(sClass))
    If Err.Number = 0 Then
      SupportSelledStyle = (retVal = 0 And hTheme <> 0)
    End If
    On Error GoTo 0
  End If
End Sub

Public Sub UnloadSelectionDraw()
  If hTheme <> 0 Then CloseThemeData hTheme
  hTheme = 0
  SupportSelledStyle = False
End Sub

Public Sub DrawSelectionRect(hDC As Long, ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Height As Long)
  Dim DrawAr As RECT
  Dim retVal As Long
  
  If SupportSelledStyle Then
    DrawAr.Top = Top
    DrawAr.Left = Left
    DrawAr.Bottom = Top + Height
    DrawAr.Right = Left + Width

    DrawThemeBackground hTheme, hDC, UxThemeLISTVIEWParts.LVP_LISTITEM, UxThemeLISTITEMStates.LIS_SELECTED, DrawAr, DrawAr
  'Else
  '  Rectangle hDC, Left, Top, Left + Width, Top + Height
  End If
End Sub


