[API]
DestroyWindow
GetParent
IsWindowVisible
SetWindowPos
ShowWindow
SetForegroundWindow
GetClientRect
CreateCompatibleDC
DeleteDC
GetDC
ReleaseDC
CreateCompatibleBitmap
SelectObject
BitBlt
DeleteObject
EnableWindow
GetWindowRect
AdjustWindowRectEx
CallWindowProcA
CallWindowProcW

[INCLUDE]
Unicode
DrawCheckListBoxItem
XPTheme_Scrollbar
RegisterClassEx
LoadCursor
GetWindowLong
ManualTab
XPTheme_Scrollbar
SetWindowLong
SendMessage

[DIRECTIVE]
LH
CustomClassesInDialogs

[DEFINE]
Public Const ComboBoxWithCheckBoxes_ClassName As String = "ComboBoxWithCheckBoxes"
Private Const CBC_ClassNameHld As String = "ComboBoxWithCheckBoxesPopup"

Private Interlocked As Boolean
Private Const MaxDisp As Long = 8&
Private hThemeComboDropButtons As Long
Private Const ScrollComboWidth As Long = 16&
Private hWndHld As Long
Private hWndCur As Long
Private IsFocused As Long

Private Const CBC_GWL_HwndCombo As Long = 0&
Private Const CBC_GWL_OldProc As Long = 4&
Private Const CBC_GWL_NumListH As Long = 8&
Private Const CBC_GWL_Font As Long = 12&
Private Const CBC_GWL_Top As Long = 16&
Private Const CBC_GWL_Left As Long = 20&
Private Const CBC_GWL_Width As Long = 24&
Private Const CBC_GWL_Height As Long = 28&
Private Const GWLSize As Long = 32&

[CODE]
Public Function ComboBoxWithCheckBoxes_Register() As Boolean
  Dim xType1 As WNDCLASSEX
  
  With xType1
    .ClassName = ComboBoxWithCheckBoxes_ClassName
    .hCursor = LoadCursor(&H7F00&)
    .hbrBackground = 6&
    .style = &H43& '4b
    .cbWndExtra = GWLSize
    End With
  If RegisterClassEx(xType1, AddressOf CBC_ClassHandler) Then
    xType1.ClassName = CBC_ClassNameHld
    xType1.style = &H808&
    If RegisterClassEx(xType1, AddressOf CBC_ClassHolder) Then
      hWndHld = CreateWindowEx(&H8&, CBC_ClassNameHld, "", &H86800000, 0&, 0&, 100&, 250&, 0&, 0&, 0&)
      If Not hWndHld = 0& Then
        ComboBoxWithCheckBoxes_Register = True
        Exit Function
        End If
      Call UnregisterClass(CBC_ClassNameHld)
      End If
    Call UnregisterClass(ComboBoxWithCheckBoxes_ClassName)
    End If
  End Function

Public Sub ComboBoxWithCheckBoxes_Unregister()
  Call DestroyWindow(hWndHld)
  Call UnregisterClass(CBC_ClassNameHld)
  Call UnregisterClass(ComboBoxWithCheckBoxes_ClassName)
  End Sub

Private Function CBC_ClassHandler(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Select Case Msg
    Case 1& 'WM_CREATE
      If IsUnicode Then
        CBC_ClassHandler = DefWindowProcW(hwnd, Msg, wParam, lParam)
        Else
        CBC_ClassHandler = DefWindowProcA(hwnd, Msg, wParam, lParam)
        End If
      If CBC_ClassHandler = 0& Then
        CBC_ClassHandler = CBC_CreateIt(hwnd, lParam)
        End If
      Exit Function
    Case 2& 'WM_DESTROY
      Call CBC_DestroyIt(hwnd)
    Case &HF& ', &H14& 'WM_PAINT = &HF
      If IsUnicode Then
        CBC_ClassHandler = DefWindowProcW(hwnd, Msg, wParam, lParam)
        Else
        CBC_ClassHandler = DefWindowProcA(hwnd, Msg, wParam, lParam)
        End If
      CBC_DrawWhiteDC hwnd, GetWindowLong(hwnd, CBC_GWL_HwndCombo)
    Case &H100&
      If wParam = 9& Then
        Call ManualTab(GetParent(hwnd), hwnd)
        Exit Function
        ElseIf wParam = 27& Then
        
        Exit Function
        ElseIf wParam = 115& Then
        GoTo KeyOpener
        Exit Function
        Else
        CBC_ClassHandler = CBC_ForwardMsg(hwnd, Msg, wParam, lParam)
        Exit Function
        End If
    Case &H101&, &H102&
      If Not wParam = 115& Then
        CBC_ClassHandler = CBC_ForwardMsg(hwnd, Msg, wParam, lParam)
        Exit Function
        End If
    Case &H180& To &H1FF&
      CBC_ClassHandler = CBC_ForwardMsg(hwnd, Msg, wParam, lParam)
      Exit Function
    Case &H201&
      If IsUnicode Then
        CBC_ClassHandler = DefWindowProcW(hwnd, Msg, wParam, lParam)
        Else
        CBC_ClassHandler = DefWindowProcA(hwnd, Msg, wParam, lParam)
        End If
KeyOpener:
      Msg = GetWindowLong(hwnd, CBC_GWL_HwndCombo)
      If IsWindowVisible(Msg) = 0& Then
'Debug.Print "PS", hwnd, Msg
        CBC_MoveOrSizeIt hwnd, Msg
        Call SetWindowPos(hWndHld, -1&, GetWindowLong(hwnd, CBC_GWL_Left), GetWindowLong(hwnd, CBC_GWL_Top), GetWindowLong(hwnd, CBC_GWL_Width), GetWindowLong(hwnd, CBC_GWL_Height), &H210&)
        ShowWindow Msg, 5&
        If Not hWndCur = Msg Then
          If Not hWndCur = 0& Then
            ShowWindow hWndCur, 0&
'            IsFocused = 0&
'            CBC_DrawWhiteDC hWndCur, GetWindowLong(hWndCur, -21&)
            CBC_DrawWhiteDC GetWindowLong(hWndCur, -21&), hWndCur
            End If
          hWndCur = Msg
          End If
        ShowWindow hWndHld, 5&
        SetForegroundWindow hWndHld
        SetFocusAPI Msg
'        Else
'        SetForegroundWindow GetParent(Msg)
'        ShowWindow hWndHld, 0&
'        ShowWindow Msg, 0&
'        hWndCur = 0&
'        'SetFocusAPI hwnd
'        Debug.Print "FocTo:", hwnd
'        'CBC_DrawWhiteDC hwnd, Msg
        End If
      If Not (IsFocused = 0& Or IsFocused = hwnd) Then
        wParam = IsFocused
        IsFocused = hwnd
        CBC_DrawWhiteDC wParam, GetWindowLong(wParam, CBC_GWL_HwndCombo)
        End If
      IsFocused = hwnd
      CBC_DrawWhiteDC IsFocused, Msg
      Exit Function
    Case 7&
      'If Not IsFocused = hwnd Then
        IsFocused = hwnd
        Call CBC_DrawWhiteDC(hwnd, GetWindowLong(hwnd, CBC_GWL_HwndCombo))
      '  End If
    Case 8&
      If IsFocused = hwnd Then
        IsFocused = 0&
        End If
        Call CBC_DrawWhiteDC(hwnd, GetWindowLong(hwnd, CBC_GWL_HwndCombo))
'        End If
    Case &H30&
      Call SetWindowLong(hwnd, CBC_GWL_Font, wParam)
      'If Not lParam = 0& Then
      '  Call CBC_DrawWhiteDC(hwnd, GetWindowLong(hwnd, CBC_GWL_HwndCombo))
      '  End If
      CBC_ClassHandler = CBC_ForwardMsg(hwnd, Msg, wParam, lParam)
      Exit Function
    End Select
  If IsUnicode Then
    CBC_ClassHandler = DefWindowProcW(hwnd, Msg, wParam, lParam)
    Else
    CBC_ClassHandler = DefWindowProcA(hwnd, Msg, wParam, lParam)
    End If
  End Function

Private Function CBC_ClassHolder(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If Msg = &H2B& Then
    Call DrawCheckListBoxItem(lParam, &H189&) ', hWndCur)
    ElseIf Msg = &H111& Then
    wParam = (wParam And &HF0000)
    If wParam > 0& And wParam < &H40000 Then
      Call CBC_DrawWhiteDC(GetWindowLong(lParam, -21&), lParam)
      End If
    ElseIf ((Msg = &H6& And wParam = 0&) Or (Msg = &H1C& And wParam = 0&)) And Not (Interlocked Or hWndCur = 0&) Then
    Interlocked = True
    ShowWindow hWndHld, 0&
    ShowWindow hWndCur, 0&
    CBC_DrawWhiteDC GetWindowLong(hWndCur, -21&), hWndCur
    IsFocused = 0&
    hwnd = GetWindowLong(hWndCur, -21&)
    hWndCur = 0&
    SetForegroundWindow GetParent(hwnd)
    SetFocusAPI hwnd
    Interlocked = False
    ElseIf IsUnicode Then
    CBC_ClassHolder = DefWindowProcW(hwnd, Msg, wParam, lParam)
    Else
    CBC_ClassHolder = DefWindowProcA(hwnd, Msg, wParam, lParam)
    End If
  End Function

Private Sub CBC_DrawWhiteDC(ByVal hwnd As Long, ByVal HWndDownCtrl As Long)
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xType1 As RECT
  Dim xType2 As DRAWITEMSTRUCT
  Dim hdc As Long
  Dim hBmp As Long
  Dim hBmpOld As Long
  Dim W1 As Long
  Dim H1 As Long
  Dim hFntOld As Long
  
  If Not GetClientRect(hwnd, xType1) = 0& Then
    hdc = CreateCompatibleDC(0&)
    If Not hdc = 0& Then
      xLong1 = GetDC(0&)
      If Not xLong1 = 0& Then
        W1 = xType1.Right - xType1.Left
        H1 = xType1.Bottom - xType1.Top
        hBmp = CreateCompatibleBitmap(xLong1, W1, H1)
        Call ReleaseDC(0&, xLong1)
        If Not hBmp = 0& Then
          hBmpOld = SelectObject(hdc, hBmp)
          If Not hBmpOld = 0& Then
            xLong2 = GetWindowLong(hwnd, CBC_GWL_Font)
            hFntOld = SelectObject(hdc, xLong2)
            If xLong2 = 0& Or Not hFntOld = 0& Then
              xType1.Left = xType1.Right - ScrollComboWidth
              With xType2
                .hdc = hdc
                .hwndItem = hwnd
                .rcItem.Right = W1 - ScrollComboWidth
                .rcItem.Bottom = H1
                'Public Const LB_GETCARETINDEX = &H19F
                'Public Const LB_GETSEL = &H187
  'Debug.Print "Foc?", IsFocused, hwnd
                If IsUnicode Then
                  xType2.itemID = SendMessageW(HWndDownCtrl, &H19F, 0&, ByVal 0&)
                  If Not xType2.itemID = -1& Then
                    xLong1 = SendMessageW(HWndDownCtrl, &H187&, xType2.itemID, ByVal 0&)
                    '&H10&
                    .itemState = -CLng(xLong1 > 0&) - &H10& * CLng(IsFocused = hwnd And IsWindowVisible(HWndDownCtrl) = 0&)
                    End If
                  Else
                  xType2.itemID = SendMessageA(HWndDownCtrl, &H19F, 0&, ByVal 0&)
  '                Debug.Print "Index:", xType2.itemID
                  If Not xType2.itemID = -1& Then
                    xLong1 = SendMessageA(HWndDownCtrl, &H187&, xType2.itemID, ByVal 0&)
  '                  Debug.Print "State:", xLong1
                    '&H10&
                    .itemState = -CLng(xLong1 > 0&) - &H10& * CLng(IsFocused = hwnd And IsWindowVisible(HWndDownCtrl) = 0&)
                    End If
                  End If
                '.itemState = &H11&
                End With
              
              If hThemeComboDropButtons = 0& Then
                ' ID And &H1&
                
                Call DrawCheckListBoxItem(VarPtr(xType2), &H189&) ', hWndCur)
                
                If IsWindowVisible(HWndDownCtrl) Then
                  Call DrawFrameControl(hdc, xType1, 3&, &H201&)
                  Else
                  Call DrawFrameControl(hdc, xType1, 3&, 1&)
                  End If
                xLong1 = GetDC(hwnd)
                If Not xLong1 = 0& Then
                  Call BitBlt(xLong1, 0&, 0&, W1, H1, hdc, 0&, 0&, vbSrcCopy)
                  Call ReleaseDC(hwnd, xLong1)
                  End If
                Else
                xLong1 = GetDC(hwnd)
                If Not xLong1 = 0& Then
                  Call BitBlt(xLong1, 0&, 0&, W1, H1, hdc, 0&, 0&, vbSrcCopy)
                  W1 = 5& - 2& * CLng(IsWindowVisible(HWndDownCtrl))
                  If Not (IsThemeBackgroundPartiallyTransparent(hThemeComboDropButtons, 1&, W1) = 0&) Then
                    Call DrawThemeParentBackground(hwnd, xLong1, xType1)
                    End If
                  Call DrawCheckListBoxItem(VarPtr(xType2), &H189&) ', hWndCur)
                  'If IsWindowVisible(HWndDownCtrl) Then
                  '  Call DrawThemeBackground(hThemeComboDropButtons, xLong1, 1&, 7&, xType1, 0&)
                  '  Else
                  '  Call DrawThemeBackground(hThemeComboDropButtons, xLong1, 1&, 5&, xType1, 0&)
                  '  End If
                  Call DrawThemeBackground(hThemeComboDropButtons, xLong1, 1&, W1, xType1, 0&)
                  
                  Call ReleaseDC(hwnd, xLong1)
                  End If
                End If
              Call SelectObject(hdc, hFntOld)
              End If
            Call SelectObject(hdc, hBmpOld)
            End If
          'Call ReleaseDC(hwnd, xLong1)
          Call DeleteObject(hBmp)
          End If
        End If
      Call DeleteDC(hdc)
      End If
    End If
  End Sub

Private Function CBC_CreateIt(ByVal hwnd As Long, ByVal CD As Long) As Long
  CBC_CreateIt = CreateWindowEx(&H0&, "LISTBOX", "", &H46210059, 0&, 0&, 100&, 250&, hWndHld, 0&, 0&)
  If CBC_CreateIt = 0& Then
    CBC_CreateIt = -1&
    Else
    'Call SetParent(CBC_CreateIt, hWndHld)
    Call CBC_MoveOrSizeIt(hwnd, CBC_CreateIt)
    Call SetWindowLong(CBC_CreateIt, -21&, hwnd)
    'Call SendMessage(CBC_CreateIt, &H30&, SendMessage(&H402EE, &H31&, 0&, 0&), 0&)
    Call SetWindowLong(hwnd, CBC_GWL_HwndCombo, CBC_CreateIt)
#If LH Then
    Call SetWindowLong(hwnd, CBC_GWL_OldProc, GetWindowLong(CBC_CreateIt, -4&))
    Call SetWindowLong(CBC_CreateIt, -4&, AddressOf CBC_ListHooker)
#End If
    CBC_CreateIt = 0&
    End If
  End Function

Private Sub CBC_MoveOrSizeIt(ByVal hWndMain As Long, ByVal hWndList As Long)
  Dim xLong1 As Long
  Dim xLong2 As Long
  'Dim xType1 As POINTAPI
  Dim xType2 As RECT
  Dim xType3 As RECT
  
'Stop
  If IsUnicode Then
    xLong1 = SendMessageW(hWndList, &H18B&, 0&, ByVal 0&)
    Call SetWindowLongW(hWndMain, CBC_GWL_NumListH, xLong1)
    If xLong1 = 0& Then GoTo ZeroSizePre
    If xLong1 > MaxDisp Then xLong1 = MaxDisp
    xLong1 = xLong1 * SendMessageW(hWndList, &H1A1, 0&, ByVal 0&)
    Else
    xLong1 = SendMessageA(hWndList, &H18B&, 0&, ByVal 0&)
    Call SetWindowLongA(hWndMain, CBC_GWL_NumListH, xLong1)
    If xLong1 = 0& Then
'Debug.Print "ZeroSize"
ZeroSizePre:
      If Not IsWindowVisible(hWndList) = 0& Then
        Call SetFocusAPI(hWndMain)
        Call ShowWindow(hWndHld, 0&)
        Call ShowWindow(hWndList, 0&)
        hWndCur = 0&
        Call EnableWindow(hWndMain, 0&)
        Call CBC_DrawWhiteDC(hWndMain, hWndList)
        Else
        Call EnableWindow(hWndMain, 0&)
        End If
      GoTo ZeroSize
      End If
    If xLong1 > MaxDisp Then xLong1 = MaxDisp
    xLong1 = xLong1 * SendMessageA(hWndList, &H1A1, 0&, ByVal 0&)
    End If
  
  Call EnableWindow(hWndMain, 1&)
  Call GetWindowRect(hWndMain, xType2)
  'xLong2 = xType2.Right - xType2.Left
  
  Call AdjustWindowRectEx(xType3, &H10A10058, 0&, 0&)
'  Debug.Print "BorderFix:", xType3.Right - xType3.Left, xType3.Bottom - xType3.Top
'  Debug.Print "Size: ", xType2.Left, xType2.Top, xType2.Right - xType2.Left, xType3.Bottom - xType3.Top + xLong1
  
  'Call SetWindowPos(hWndList, -1&, xType2.Left, xType2.Bottom, xType2.Right - xType2.Left, xType3.Bottom - xType3.Top + xLong1, &H210&)
  'Debug.Print "SizeC: ", 0&, 0&, xType2.Right - xType2.Left, xLong1
  Call SetWindowPos(hWndList, -1&, 0&, 0&, xType2.Right - xType2.Left, xLong1, &H216&)
  xLong2 = xType2.Right - xType2.Left
  xLong1 = xType3.Bottom - xType3.Top + xLong1
  'Debug.Print "SizeP: ", xType2.Left, xType2.Bottom, xLong2, xLong1
  Call SetWindowLong(hWndMain, CBC_GWL_Left, xType2.Left)
  Call SetWindowLong(hWndMain, CBC_GWL_Top, xType2.Bottom)
  Call SetWindowLong(hWndMain, CBC_GWL_Width, xLong2)
  Call SetWindowLong(hWndMain, CBC_GWL_Height, xLong1)
  If hWndCur = hWndList Then
    Call SetWindowPos(hWndHld, -1&, xType2.Left, xType2.Bottom, xLong2, xLong1, &H210&)
    End If

ZeroSize:
  
  End Sub

Private Sub CBC_DestroyIt(ByVal hwnd As Long)
  Dim xLong1 As Long
  
  xLong1 = GetWindowLong(hwnd, CBC_GWL_HwndCombo)
  If Not xLong1 = 0& Then
    Call SetWindowLong(xLong1, -21&, 0&)
#If LH Then
    Call SetWindowLong(xLong1, -4&, GetWindowLong(hwnd, CBC_GWL_OldProc))
#End If
    Call SetWindowLong(hwnd, CBC_GWL_HwndCombo, 0&)
    Call DestroyWindow(xLong1)
    End If
  End Sub

Private Function CBC_ForwardMsg(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  Dim xLong1 As Long
  
  If IsUnicode Then
    xLong1 = GetWindowLongW(hwnd, CBC_GWL_HwndCombo)
#If LH Then
    CBC_ForwardMsg = CallWindowProcW(GetWindowLongW(hwnd, CBC_GWL_OldProc), xLong1, Msg, wParam, lParam)
#Else
    CBC_ForwardMsg = SendMessageW(xLong1, Msg, wParam, ByVal lParam)
#End If
    Else
    xLong1 = GetWindowLongA(hwnd, CBC_GWL_HwndCombo)
#If LH Then
    CBC_ForwardMsg = CallWindowProcA(GetWindowLongA(hwnd, CBC_GWL_OldProc), xLong1, Msg, wParam, lParam)
#Else
    CBC_ForwardMsg = SendMessageA(xLong1, Msg, wParam, ByVal lParam)
#End If
    End If

  Select Case Msg
    Case &H180&, &H181&, &H196& 'add/ins/addfile
      If CBC_ForwardMsg > -1& Then
        If IsUnicode Then
          If GetWindowLongW(hwnd, CBC_GWL_NumListH) < MaxDisp Then CBC_MoveOrSizeIt hwnd, xLong1
          Else
          If GetWindowLongA(hwnd, CBC_GWL_NumListH) < MaxDisp Then CBC_MoveOrSizeIt hwnd, xLong1
          End If
        CBC_DrawWhiteDC hwnd, xLong1
        End If
    Case &H182& 'delete
      If Not CBC_ForwardMsg = -1& Then
        CBC_MoveOrSizeIt hwnd, xLong1
        CBC_DrawWhiteDC hwnd, xLong1
        End If
    Case &H184& 'clear
      CBC_MoveOrSizeIt hwnd, xLong1
      CBC_DrawWhiteDC hwnd, xLong1
    End Select

  End Function

#If LH Then
Private Function CBC_ListHooker(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Debug.Print "HideHook2L", hwnd, Msg, wParam, lParam
  If Msg = &H100& Then
    If wParam = 9& Then
      ShowWindow hWndHld, 0&
      ShowWindow hwnd, 0&
      CBC_DrawWhiteDC GetWindowLong(hwnd, -21&), hwnd
      hWndCur = 0&
      hwnd = GetWindowLong(hwnd, -21&)
      Msg = GetParent(hwnd)
      SetForegroundWindow Msg
      Call ManualTab(Msg, hwnd)
      ElseIf (wParam = 27& Or wParam = 115&) Then
      ShowWindow hWndHld, 0&
      ShowWindow hwnd, 0&
      CBC_DrawWhiteDC GetWindowLong(hwnd, -21&), hwnd
      hWndCur = 0&
      hwnd = GetWindowLong(hwnd, -21&)
      SetForegroundWindow GetParent(hwnd)
      SetFocusAPI hwnd
      CBC_ListHooker = 1&
      ElseIf IsUnicode Then
      CBC_ListHooker = CallWindowProcW(GetWindowLongW(GetWindowLongW(hwnd, -21&), CBC_GWL_OldProc), hwnd, Msg, wParam, lParam)
      Else
      'Debug.Print "Key", wParam
      CBC_ListHooker = CallWindowProcA(GetWindowLongA(GetWindowLongA(hwnd, -21&), CBC_GWL_OldProc), hwnd, Msg, wParam, lParam)
      End If
    ElseIf IsUnicode Then
    CBC_ListHooker = CallWindowProcW(GetWindowLongW(GetWindowLongW(hwnd, -21&), CBC_GWL_OldProc), hwnd, Msg, wParam, lParam)
    Else
    CBC_ListHooker = CallWindowProcA(GetWindowLongA(GetWindowLongA(hwnd, -21&), CBC_GWL_OldProc), hwnd, Msg, wParam, lParam)
    End If
  End Function
#End If
