Based on [Retrieving icons of current user printers](https://stackoverflow.com/a/1183185/40691)

cPrintersCombo.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cPrintersCombo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'=========================================================================
' $Header: /Dreem/1.5/Src/Common/cPrintersCombo.cls 66    21.02.24 17:09 Wqw $
'
'   Dreem Enterprise Project
'   Copyright (c) 2003-2024 Unicontsoft
'
'   Enum Printers virtual folder
'
' $Log: /Dreem/1.5/Src/Common/cPrintersCombo.cls $
' 
' 66    21.02.24 17:09 Wqw
' REF: guard GetUIObjectOf samo za visible
'
' 65    14.02.24 13:45 Wqw
' REF: mark instance name terminated
'
' 64    15.11.23 10:18 Wqw
' REF: reorder params na err handling
'
' 63    7.04.23 17:52 Wqw
' REF: ne polzwa directno methods/props na app
'
' 62    8.01.23 15:20 Wqw
' REF: stop using hidden enum entries other than dummy [underscore]
'
' 61    13.10.22 14:19 Wqw
' REF: draw text text param
'
' 60    7.10.22 11:07 Wqw
' REF: unicode send/post message
'
' 59    4.10.22 17:09 Wqw
' REF: polzwa unicode API declares
'
' 58    25.03.22 14:31 Wqw
' REF: polzwa screen physical height
'
' 57    3.02.22 11:21 Wqw
' REF: wika do events na update info samo ako e drop-nato combo-to
'
' 56    18.06.21 17:11 Wqw
' REF: mark terminated
'
' 55    26.03.21 11:31 Wqw
' REF: polzwa null char
'
' 54    13.05.20 20:45 Wqw
' REF: polzwa expliciten TerminateXxxThunk
'
' 53    17.04.19 13:53 Wqw
' REF: hide subclass/timer proc
'
' 52    12.04.19 12:24 Wqw
' REF: suppress err server died w print error
'
' 51    8.04.19 22:07 Wqw
' REF: polzwa MST
'
' 50    11.02.19 10:22 Wqw
' REF: polzwa val ot env var
'
' 49    16.01.19 13:45 Wqw
' REF: get info tip moje da fail-ne
'
' 48    2.01.19 16:13 Wqw
' REF: VSS restore
'
' 49    14.12.18 15:07 Wqw
' REF: impl cjange notification za update item
'
' 48    11.12.18 15:49 Wqw
' ADD: local border width i align to pix
'
' 47    18.12.17 16:25 Wqw
' REF: api declares bez dll extension
'
' 46    19.05.17 17:48 Wqw
' REF: separate value/text columns
'
' 45    13.04.17 18:32 Wqw
' REF: polzwa get error environment var
'
' 44    16.09.16 13:53 Wqw
' ADD: Function frGetPrintersFolder
'
' 43    30.06.16 14:59 Wqw
' REF: instance/module name
'
' 42    24.02.16 15:09 Wqw
' REF: ret val na search collection
'
' 41    16.01.16 15:34 Wqw
' REF: prowerka init font/mem dc
'
' 40    7.04.15 20:00 Wqw
' REF: impl err handling s retry
'
' 39    18.03.15 18:28 Wqw
' REF: gardira se ako change notify register prashta nerazbiraemi pidl
'
' 38    15.01.15 18:44 Wqw
' REF: optional params bez prefix
'
' 37    12.01.15 14:56 Wqw
' REF: err handling na wnd proc
'
' 36    17.11.14 20:08 Wqw
' REF: impl stricten err handling na events
'
' 35    11.10.14 12:58 Wqw
' REF: polzwa string varianti na funktsii
'
' 34    10.10.14 1:26 Wqw
' REF: polzwa unsigned pointer aritmetika
'
' 33    17.01.14 19:14 Wqw
' REF: do 50 printer-a se autorefresh-wa
'
' 32    18.10.13 0:38 Wqw
' REF: fix NT bug w get device name
'
' 31    9.10.13 17:48 Wqw
' REF: do events na update info
'
' 30    18.04.13 17:01 Wqw
' REF: named params na InitFireOnceTimer
'
' 29    8.04.13 16:26 Wqw
' REF: cache na printers shell folder
'
' 28    7.04.13 1:49 Wqw
' REF: polzwa static shell folder na initialize
'
' 27    22.03.13 18:23 Wqw
' REF: break on all errors
'
' 26    22.02.13 19:10 Wqw
' REF: prowerka dublirane na printeri w enum printer
'
' 25    30.05.12 18:10 Wqw
' REF: gardira se ako EnumObjects wyrne nothing i w pvUpdatePrinterInfo
'
' 24    30.05.12 17:30 Wqw
' REF: frEnumPrinters se gardira ako EnumObjects ne e impl
'
' 23    27.04.12 9:42 Wqw
' REF: ne polzwa screen obekta
'
' 22    21.01.12 17:34 Wqw
' REF: prowerqwa resultat ot GetData w pvGetDeviceName
'
' 21    29.10.11 18:23 Wqw
' REF: polzwa combo-to direktno
'
' 20    29.10.11 0:26 Wqw
' REF: sync na combo pri change notification
'
' 19    28.10.11 14:52 Wqw
' REF: impl change notification ot printers folder
'
' 18    18.08.11 17:24 Wqw
' REF: polzwa InitFontDC
'
' 17    29.06.11 15:00 Wqw
' REF: gardira pvTimerAction [let] ot nekorekten state
'
' 16    11.09.10 13:54 Wqw
' REF: na terminate zachistwa timer action
'
' 15    4.02.10 19:54 Wqw
' REF: re-dim s expliciten type
'
' 14    12.01.10 23:03 Wqw
' REF: gardira se ako ne moje da dostypi virtualniq folder
'
' 13    16.11.09 19:29 Wqw
' REF: replace na infotip za da raboti pod win2k
'
' 12    3.11.09 17:19 Wqw
' REF: w debug mode MODULE_NAME sydyrja debug id
'
' 11    17.10.09 1:13 Wqw
' REF: ne gyrmi pod win98
'
' 10    2.10.09 19:23 Wqw
' REF: ne exponira VB.Collection na public interface-a
'
' 9     1.08.09 16:15 Wqw
' ADD: Function frEnumPrinters
'
' 8     31.07.09 19:08 Wqw
' REF: polzwa timer action za init status
'
' 7     31.07.09 14:38 Wqw
' REF: draw item se integrira s fore/back color na ctrl, a win7 e
' wyzmojno da se "setsne" enumeratsiqta pyrwiq pyt ako e natowareno CPU
' na 100%
'
' 6     29.07.09 21:39 Wqw
' REF: m_cPrinters baziwana na VB.Printers
'
' 5     28.07.09 20:02 Wqw
' REF: delay load na status-i
'
' 4     27.07.09 21:19 Wqw
' REF: risuwa disabled icon-a s blend 50%
'
' 3     27.07.09 19:21 Wqw
' REF: pri disabled integratsiq s tabstrip pane background
'
' 2     27.07.09 17:44 Wqw
' REF: razmer edit box namalen, na close up prawi refresh na printerite
'
' 1     27.07.09 16:07 Wqw
' Initial implementation
'
'=========================================================================
Option Explicit
DefObj A-Z
Private Const STR_MODULE_NAME As String = "cPrintersCombo"
Implements IUcsTerminate

'=========================================================================
' API
'=========================================================================

Private Const MAX_PATH                  As Long = 260
'--- for SHGetSpecialFolderLocation
Private Const CSIDL_PRINTERS            As Long = &H4
'--- for SHGetFileInfo
Private Const SHGFI_LARGEICON           As Long = &H0
Private Const SHGFI_SMALLICON           As Long = &H1
Private Const SHGFI_SHELLICONSIZE       As Long = &H4
Private Const SHGFI_PIDL                As Long = &H8
Private Const SHGFI_DISPLAYNAME         As Long = &H200
Private Const SHGFI_SYSICONINDEX        As Long = &H4000
'--- for IShellFolder.EnumObjects
Private Const SHCONTF_NONFOLDERS        As Long = &H40
'--- for ImageList_Draw
Private Const ILD_TRANSPARENT           As Long = &H1
Private Const ILD_BLEND25               As Long = &H2
Private Const ILD_BLEND50               As Long = &H4
'--- for IQueryInfo.GetInfoTip
Private Const QITIPF_SINGLELINE         As Long = &H10
'--- for GetSystemMetrics
Private Const SM_CXVSCROLL              As Long = 2
'--- for SHChangeNotifyRegister
Private Const SHCNE_CREATE              As Long = &H2
Private Const SHCNE_DELETE              As Long = &H4
Private Const SHCNE_UPDATEITEM          As Long = &H2000
Private Const SHCNE_ALLEVENTS           As Long = &H7FFFFFFF
Private Const SHCNRF_ShellLevel         As Long = 2
'--- windows msgs
Private Const WM_CTLCOLORBTN            As Long = &H135
Private Const WM_MYNOTIFY               As Long = &H1000 + 100
Private Const WM_COMMAND                As Long = &H111
Private Const CBN_DOITEMDATA            As Long = 10002

Private Declare Function SHGetDesktopFolder Lib "shell32" (ppshf As IShellFolder) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hWndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoW" (pszPath As Any, ByVal dwFileAttributes As Long, ByVal psfi As Long, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function ImageList_Draw Lib "comctl32" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal X As Long, ByVal Y As Long, ByVal fStyle As Long) As Long
Private Declare Function ImageList_DrawEx Lib "comctl32" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal rgbBk As Long, ByVal rgbFg As Long, ByVal fStyle As Long) As Long
Private Declare Function ImageList_GetIconSize Lib "comctl32" (ByVal himl As Long, cx As Long, cy As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hDC As Long, lpRect As RECT) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd 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 SendMessage Lib "user32" Alias "SendMessageW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SHChangeNotifyRegister Lib "shell32" Alias "#2" (ByVal hWnd As Long, ByVal uFlags As Long, ByVal dwEventID As Long, ByVal uMsg As Long, ByVal cItems As Long, lpps As Any) As Long

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

Private Type SHFILEINFO
    hIcon               As Long
    iIcon               As Long
    dwAttributes        As Long
    szDisplayName       As String * MAX_PATH
    szTypeName          As String * 80
End Type

Private Type POINTAPI
    X                   As Long
    Y                   As Long
End Type

Private Type DROPFILES
    pFiles              As Long     ' offset of file list
    pt                  As POINTAPI ' drop point (client coords)
    fNC                 As Long     ' is it on NonClient area and pt is in screen coords
    fWide               As Long     ' WIDE character switch
End Type

Private Type SHCHANGENOTIFYENTRY
    pidl                As Long
    bWatchSubFolders    As Long
End Type

Private Type SHNOTIFYSTRUCT
    dwItem1             As Long
    dwItem2             As Long
End Type

'=========================================================================
' Constants and member variables
'=========================================================================

Private IID_IShellFolder(0 To 3)    As Long
Private IID_IDataObject(0 To 3)     As Long
Private IID_IQueryInfo(0 To 3)      As Long

Private m_oForm                 As cFormManager
Private WithEvents m_oCtl       As DirectCobCombo
Attribute m_oCtl.VB_VarHelpID = -1
Private m_cPrinters             As Collection
Private m_bEnabled              As Boolean
Private m_pPrintersFolder       As IShellFolder
Private m_pidlPrinters()        As Byte
'--- UI elements
Private m_pNormalFont           As IFont
Private m_pBoldFont             As IFont
Private m_pItalicFont           As IFont
Private m_lIndent               As Long
Private m_cxLarge               As Long
Private m_cyLarge               As Long
Private m_cxSmall               As Long
Private m_cySmall               As Long
Private m_lOrigItemHeight       As Long
Private m_pTimer                As IUnknown
Private m_eTimerAction          As UcsFormTimerAction
Private m_hShellNotify          As Long
Private m_pCleanupNotify        As IUnknown
Private m_hWnd                  As Long
Private m_pSubclass             As IUnknown
Private m_bInUpdatePrinterInfo  As Boolean
Private m_bIsServerDiedLogged   As Boolean
'--- debug
Private m_sInstanceName         As String
#If DebugMode Then
    Private m_sDebugID          As String
#End If

Private Enum UcsInfoIndexes
    ucsIdxDeviceName
    ucsIdxDisplayName
    ucsIdxToolTip
    ucsIdxLargeImageList
    ucsIdxLargeIconIndex
    ucsIdxSmallImageList
    ucsIdxSmallIconIndex
End Enum

Private Enum UcsFormTimerAction '--- bitmask
    ucsTmrInitStatus = 2 ^ 0
    ucsTmrUpdateStatus = 2 ^ 1
    ucsTmrDelayUpdateStatus = 2 ^ 2
    ucsTmrAll = 2 ^ 3 - 1
End Enum

Private Enum UcsComboColumnsEnum
    c_Value = 0
    c_Text
End Enum

'=========================================================================
' Error management
'=========================================================================

Friend Property Get frInstanceName() As String
    frInstanceName = m_sInstanceName
End Property

Private Property Get MODULE_NAME() As String
    #If DebugMode Then
        MODULE_NAME = GetModuleInstance(STR_MODULE_NAME, frInstanceName, m_sDebugID)
    #Else
        MODULE_NAME = GetModuleInstance(STR_MODULE_NAME, frInstanceName)
    #End If
End Property

Private Function RaiseError(sFunction As String) As VbMsgBoxResult
    Dim vErr            As Variant
    
    PushError vErr
    RaiseError = GAppHandleOutOfMemory(vErr)
    If RaiseError <> vbRetry Then
        PopRaiseError vErr, MODULE_NAME, sFunction
    End If
End Function

Private Function PrintError(sFunction As String) As VbMsgBoxResult
    Dim vErr            As Variant
    
    PushError vErr
    If vErr(ucsErrNumber) = ERR_RPC_E_SERVER_DIED Then
        If m_bIsServerDiedLogged Then
            Exit Function
        End If
        m_bIsServerDiedLogged = True
    End If
    PrintError = GAppHandleOutOfMemory(vErr)
    If PrintError <> vbRetry Then
        PopPrintError vErr, MODULE_NAME, sFunction
    End If
End Function

'=========================================================================
' Properties
'=========================================================================

Property Get Printers() As Object
    Set Printers = frPrinters
End Property

Friend Property Get frPrinters() As Collection
    Dim vInfo           As Variant
    Dim vElem           As Variant
    
    If m_cPrinters Is Nothing Then
        '--- create printers collection from Printers virtual folder
        Set m_cPrinters = New Collection
        vInfo = Array(vbNullString, vbNullString, vbNullString, 0, 0, 0, 0)
        For Each vElem In frEnumPrinters
            vInfo(ucsIdxDeviceName) = vElem
            vInfo(ucsIdxDisplayName) = vElem
            m_cPrinters.Add vInfo, vInfo(ucsIdxDeviceName)
        Next
    End If
    Set frPrinters = m_cPrinters
End Property

Property Get Enabled() As Boolean
    Enabled = m_bEnabled
End Property

Property Let Enabled(ByVal bValue As Boolean)
    Const FUNC_NAME     As String = "Enabled [let]"
    
    On Error GoTo EH
    m_bEnabled = bValue
    If bValue Then
        m_oCtl.ColumnWidths(c_Text) = pvCalcMaxWidth(m_cPrinters)
    Else
        m_oCtl.ColumnWidths(c_Text) = -1
    End If
    Exit Property
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Property

Private Property Get pvTimerAction(ByVal eType As UcsFormTimerAction) As Boolean
    pvTimerAction = ((m_eTimerAction And eType) <> 0)
End Property

Private Property Let pvTimerAction(ByVal eType As UcsFormTimerAction, ByVal bValue As Boolean)
    Const FUNC_NAME     As String = "pvTimerAction [let]"
    
    On Error GoTo EH
    #If DebugMode Then
        If (m_eTimerAction Or ucsTmrAll) <> ucsTmrAll Then
            DebugPrint MODULE_NAME, FUNC_NAME, Printf(STR_ERR_INVALID_TIMER_STATE, Hex$(m_eTimerAction))
        End If
        If (eType Or ucsTmrAll) <> ucsTmrAll Then
            Err.Raise vbObjectError, , Printf(STR_ERR_INVALID_TIMER_ACTION, Hex$(eType))
        End If
    #End If
    If bValue Then
        m_eTimerAction = (m_eTimerAction Or eType) And ucsTmrAll
        If ThunkPrivateData(m_pTimer) = 0 And m_eTimerAction <> 0 Then
            Set m_pTimer = InitFireOnceTimerThunk(Me, pvAddressOfTimerProc.TimerProc, Delay:=IIf(eType = ucsTmrDelayUpdateStatus, 1000, 0))
        End If
    Else
        m_eTimerAction = (m_eTimerAction And Not eType) And ucsTmrAll
        If ThunkPrivateData(m_pTimer) <> 0 And m_eTimerAction = 0 Then
            TerminateFireOnceTimerThunk m_pTimer, Me
        End If
    End If
    
    Exit Property
EH:
    If RaiseError(FUNC_NAME) = vbRetry Then
        Resume
    End If
End Property

Private Property Get pvAddressOfSubclassProc() As cPrintersCombo
    Set pvAddressOfSubclassProc = InitAddressOfMethod(Me, 5)
End Property

Private Property Get pvAddressOfTimerProc() As cPrintersCombo
    Set pvAddressOfTimerProc = InitAddressOfMethod(Me, 0)
End Property

'=========================================================================
' Methods
'=========================================================================

Friend Function frInit(oExt As cComboExtension, sDeviceName As String) As Boolean
    Const FUNC_NAME     As String = "frInit"
    Static lNotify      As Long
    Dim vElem           As Variant
    Dim uNotify         As SHCHANGENOTIFYENTRY
    
    On Error GoTo EH
    '--- init member vars
    m_sInstanceName = oExt.frInstanceName
    #If DebugMode Then
        DebugInstanceName frInstanceName, m_sDebugID
    #End If
    Set m_oForm = oExt.Form
    Set m_oCtl = oExt.frControl
    Set m_pNormalFont = m_oCtl.Font
    Set m_pBoldFont = CloneFont(m_pNormalFont)
    m_pBoldFont.Bold = True
    Set m_pItalicFont = CloneFont(m_pNormalFont)
    m_pItalicFont.Italic = True
    m_lOrigItemHeight = GetFontHeight(m_oCtl.Font)
    m_bEnabled = True
    m_lIndent = 480 / ScreenTwipsPerPixelX
    m_cxSmall = 16
    m_cySmall = 16
    Set m_cPrinters = Printers
    '--- setup notifications
    m_hWnd = m_oCtl.hWnd
    Set m_pSubclass = InitSubclassingThunk(m_hWnd, Me, pvAddressOfSubclassProc.ComboSubclassProc(0, 0, 0, 0, 0))
    If lNotify = 0 Then
        lNotify = IIf(Val(GetErrorEnvironmentVar("_UCS_DREEM_NO_PRINTERCOMBO_NOTIFY")) <> 0, -1, 1)
    End If
    If lNotify = 1 Then
        uNotify.pidl = VarPtr(m_pidlPrinters(0))
        uNotify.bWatchSubFolders = 1
        m_hShellNotify = SHChangeNotifyRegister(m_hWnd, SHCNRF_ShellLevel, SHCNE_ALLEVENTS, WM_MYNOTIFY, 1, uNotify)
        Set m_pCleanupNotify = InitCleanupThunk(m_hShellNotify, "shell32", "#4") ' SHChangeNotifyDeregister
    End If
    '--- fill combo
    m_oCtl.Clear
    For Each vElem In m_cPrinters
        m_oCtl.AddItem Array(ToSessionPrinter(C_Str(vElem(ucsIdxDeviceName))), vElem(ucsIdxDeviceName))
        If LCase$(vElem(ucsIdxDeviceName)) = LCase$(sDeviceName) Then
            m_oCtl.ListIndex = m_oCtl.ListCount - 1
        End If
    Next
    pvTimerAction(ucsTmrInitStatus) = True
    TimerProc
    Exit Function
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Function

Public Function EnumPrinters() As Object
    Set EnumPrinters = frEnumPrinters
End Function

Public Function TimerProc() As Long
Attribute TimerProc.VB_MemberFlags = "40"
    Const FUNC_NAME     As String = "TimerProc"
    
    On Error GoTo EH
    '--- delay update
    If m_bInUpdatePrinterInfo Then
        pvTimerAction(m_eTimerAction) = True
        Exit Function
    End If
    If pvTimerAction(ucsTmrInitStatus) Then
        pvTimerAction(ucsTmrInitStatus) = False
        If pvUpdatePrinterInfo(False) Then
            m_oCtl.ColumnWidths(c_Text) = pvCalcMaxWidth(m_cPrinters)
            m_oCtl.Refresh
        End If
    ElseIf pvTimerAction(ucsTmrUpdateStatus Or ucsTmrDelayUpdateStatus) Then
        pvTimerAction(ucsTmrUpdateStatus Or ucsTmrDelayUpdateStatus) = False
        If pvUpdatePrinterInfo(True) Then
            m_oCtl.ColumnWidths(c_Text) = pvCalcMaxWidth(m_cPrinters)
        End If
        If Not m_oCtl Is Nothing Then
            If m_oCtl.DropDown Then
                pvTimerAction(ucsTmrDelayUpdateStatus) = True
            End If
        End If
    End If
    Exit Function
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Function

Public Function ComboSubclassProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, Handled As Boolean) As Long
Attribute ComboSubclassProc.VB_MemberFlags = "40"
    Const FUNC_NAME     As String = "ComboSubclassProc"
    Dim uNotify         As SHNOTIFYSTRUCT
    Dim pDataObject     As IDataObject
    Dim sDeviceName     As String
    Dim vElem           As Variant
    Dim pidlCurrent()   As Byte
    Dim lIdx            As Long
    Dim bDropped        As Boolean
    Dim vInfo           As Variant
    
    On Error GoTo EH
    Handled = True
    Select Case wMsg
    Case WM_MYNOTIFY
        Call CopyMemory(uNotify, ByVal wParam, LenB(uNotify))
        Select Case lParam
        Case SHCNE_CREATE, SHCNE_DELETE, SHCNE_UPDATEITEM
            pidlCurrent = pvToPidl(uNotify.dwItem1, Release:=False)
            If IsWindowVisible(hWnd) Then
                '--- moje da fail-ne pod win10
                On Error Resume Next '--- checked
                Call m_pPrintersFolder.GetUIObjectOf(0, 1, VarPtr(pidlCurrent(UBound(m_pidlPrinters) - 1)), IID_IDataObject(0), 0, pDataObject)
                On Error GoTo EH
            End If
            sDeviceName = pvGetDeviceName(pDataObject)
        End Select
        If LenB(sDeviceName) <> 0 Then
            Select Case lParam
            Case SHCNE_DELETE
                RemoveCollection m_cPrinters, sDeviceName
            Case SHCNE_CREATE
                If Not SearchCollection(m_cPrinters, sDeviceName) Then
                    vInfo = Array(vbNullString, vbNullString, vbNullString, 0, 0, 0, 0)
                    vInfo(ucsIdxDeviceName) = sDeviceName
                    vInfo(ucsIdxDisplayName) = sDeviceName
                    m_cPrinters.Add vInfo, sDeviceName
                End If
            Case SHCNE_UPDATEITEM
                pvTimerAction(ucsTmrUpdateStatus) = True
            End Select
            If m_oCtl.ListCount < 50 Then
                bDropped = m_oCtl.DropDown
                For Each vElem In m_cPrinters
                    If lIdx < m_oCtl.ListCount Then
                        If m_oCtl.Item(c_Text, lIdx) <> vElem(ucsIdxDeviceName) Then
                            m_oCtl.Item(c_Value, lIdx) = ToSessionPrinter(C_Str(vElem(ucsIdxDeviceName)))
                            m_oCtl.Item(c_Text, lIdx) = vElem(ucsIdxDeviceName)
                        End If
                    Else
                        m_oCtl.AddItem Array(ToSessionPrinter(C_Str(vElem(ucsIdxDeviceName))), vElem(ucsIdxDeviceName))
                    End If
                    lIdx = lIdx + 1
                Next
                Do While lIdx < m_oCtl.ListCount
                    m_oCtl.RemoveItem lIdx
                Loop
                If bDropped Then
                    Call SendMessage(m_oCtl.hWnd, WM_COMMAND, CBN_DOITEMDATA * &H10000, ByVal m_oCtl.hWndCombo)
                    m_oCtl.DropDown = True
                    If m_bEnabled Then
                        pvTimerAction(ucsTmrUpdateStatus) = True
                    End If
                End If
            End If
        End If
    End Select
    ComboSubclassProc = CallNextSubclassProc(m_pSubclass, hWnd, wMsg, wParam, lParam)
    Exit Function
EH:
    If PrintError(FUNC_NAME & "(hWnd=" & hWnd & ", wMsg=" & wMsg & ", lParam=" & lParam & ", wParam=" & wParam & ")") = vbRetry Then
        Resume
    End If
    Resume Next
End Function

'= friend ================================================================

Friend Function frEnumPrinters() As Collection
    Const FUNC_NAME     As String = "frEnumPrinters"
    Dim lPtr            As Long
    Dim pEnumIds        As IEnumIDList
    Dim pDataObject     As IDataObject
    Dim pidlCurrent()   As Byte
    Dim sDeviceName     As String
    Dim vElem           As Variant
    
    On Error GoTo EH
    Set frEnumPrinters = New Collection
    If m_pPrintersFolder Is Nothing Then
        m_pidlPrinters = frGetPrintersFolder(m_pPrintersFolder)
    End If
    If Not m_pPrintersFolder Is Nothing Then
        Call m_pPrintersFolder.EnumObjects(0, SHCONTF_NONFOLDERS, pEnumIds)
    End If
    If Not pEnumIds Is Nothing Then
        Do While pEnumIds.Next(1, lPtr) = 1
            pidlCurrent = pvToPidl(lPtr)
            '--- get DeviceName
            Set pDataObject = Nothing
            Call m_pPrintersFolder.GetUIObjectOf(0, 1, VarPtr(pidlCurrent(0)), IID_IDataObject(0), 0, pDataObject)
            sDeviceName = pvGetDeviceName(pDataObject)
            If LenB(sDeviceName) <> 0 And sDeviceName <> "WinUtils_NewObject" And Not SearchCollection(frEnumPrinters, sDeviceName) Then
                frEnumPrinters.Add sDeviceName, sDeviceName
            End If
        Loop
    Else
        For Each vElem In VB.Printers
            sDeviceName = vElem.DeviceName
            If Not SearchCollection(frEnumPrinters, sDeviceName) Then
                frEnumPrinters.Add sDeviceName, sDeviceName
            End If
        Next
    End If
    Exit Function
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Function

Friend Function frGetPrintersFolder(Optional pPrintersFolder As IShellFolder, Optional ByVal Flush As Boolean) As Byte()
    Const FUNC_NAME     As String = "frGetPrintersFolder"
    Static g_pidlPrinters()     As Byte
    Static g_pPrintersFolder    As IShellFolder
    Dim pDesktopFolder  As IShellFolder
    Dim lPtr            As Long
    
    On Error GoTo EH
    If Flush Then
        Erase g_pidlPrinters
        Set g_pPrintersFolder = Nothing
    ElseIf g_pPrintersFolder Is Nothing Then
        '--- init shell folders
        Call SHGetDesktopFolder(pDesktopFolder)
        Call SHGetSpecialFolderLocation(0, CSIDL_PRINTERS, lPtr)
        g_pidlPrinters = pvToPidl(lPtr)
        '--- moje da grymne s "permission denied" pod Wine
        On Error Resume Next '--- checked
        Call pDesktopFolder.BindToObject(g_pidlPrinters(0), 0, IID_IShellFolder(0), g_pPrintersFolder)
        On Error GoTo 0
    End If
    Set pPrintersFolder = g_pPrintersFolder
    frGetPrintersFolder = g_pidlPrinters
    Exit Function
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Function

Private Function pvGetDeviceName(pDataObject As IDataObject) As String
    Dim uFmte           As FORMATETC
    Dim uStorage        As STGMEDIUM
    Dim uDrop           As DROPFILES
    Dim sTemp           As String
    Dim lPtr            As Long
    
    If Not pDataObject Is Nothing Then
        With uFmte
            .cfFormat = RegisterClipboardFormat(CFSTR_PRINTERGROUP)
            .dwAspect = ucsDvaContent
            .lIndex = -1
            .tymed = ucsTmdHGlobal
        End With
        If pDataObject.GetData(uFmte, uStorage) = S_OK Then
            lPtr = GlobalLock(uStorage.pData)
            If lPtr <> 0 Then
                Call CopyMemory(uDrop, ByVal lPtr, LenB(uDrop))
                If uDrop.fWide <> 0 Then
                    pvGetDeviceName = SysAllocString(UnsignedAdd(lPtr, uDrop.pFiles))
                ElseIf lstrlenA(UnsignedAdd(lPtr, uDrop.pFiles)) = 1 Then   '--- bug w NT4: fWide = 0
                    pvGetDeviceName = SysAllocString(UnsignedAdd(lPtr, uDrop.pFiles))
                Else
                    sTemp = String$(lstrlenA(UnsignedAdd(lPtr, uDrop.pFiles)), 0)
                    Call CopyMemory(ByVal sTemp, ByVal UnsignedAdd(lPtr, uDrop.pFiles), Len(sTemp))
                    pvGetDeviceName = sTemp
                End If
                Call GlobalUnlock(uStorage.pData)
            End If
            Call ReleaseStgMedium(uStorage)
        End If
    End If
End Function

Private Function pvUpdateCollection(cPrinters As Collection, vInfo As Variant) As Boolean
    Dim lIdx            As Long
    Dim vElem           As Variant
    
    If SearchCollection(cPrinters, vInfo(ucsIdxDeviceName)) Then
        For Each vElem In cPrinters
            lIdx = lIdx + 1
            If LCase$(vElem(ucsIdxDeviceName)) = LCase$(vInfo(ucsIdxDeviceName)) Then
                If vElem(ucsIdxDisplayName) <> vInfo(ucsIdxDisplayName) Or _
                        vElem(ucsIdxToolTip) <> vInfo(ucsIdxToolTip) Or _
                        vElem(ucsIdxLargeImageList) <> vInfo(ucsIdxLargeImageList) Or _
                        vElem(ucsIdxLargeIconIndex) <> vInfo(ucsIdxLargeIconIndex) Or _
                        vElem(ucsIdxSmallImageList) <> vInfo(ucsIdxSmallImageList) Or _
                        vElem(ucsIdxSmallIconIndex) <> vInfo(ucsIdxSmallIconIndex) Then
                    cPrinters.Remove lIdx
                    If lIdx < cPrinters.Count Then
                        cPrinters.Add vInfo, vInfo(ucsIdxDeviceName), lIdx
                    Else
                        cPrinters.Add vInfo, vInfo(ucsIdxDeviceName)
                    End If
                    pvUpdateCollection = True
                End If
                Exit Function
            End If
        Next
    End If
End Function

Private Function pvUpdatePrinterInfo(ByVal bTooltip As Boolean) As Boolean
    Const FUNC_NAME     As String = "pvUpdatePrinterInfo"
    Dim pEnumIds        As IEnumIDList
    Dim pDataObject     As IDataObject
    Dim pidlCurrent()   As Byte
    Dim pidlAbsolute()  As Byte
    Dim lPtr            As Long
    Dim uInfo           As SHFILEINFO
    Dim vInfo           As Variant
    Dim lItemHeight     As Long
    Dim pQueryInfo      As IQueryInfo
    Dim rc              As RECT
    
    On Error GoTo EH
    m_bInUpdatePrinterInfo = True
    '--- retrieve enumerator of Printers virtual folder
    If Not m_pPrintersFolder Is Nothing Then
        Call m_pPrintersFolder.EnumObjects(0, SHCONTF_NONFOLDERS, pEnumIds)
    End If
    If Not pEnumIds Is Nothing Then
        '--- loop printers
        Do While pEnumIds.Next(1, lPtr) = 1
            pidlCurrent = pvToPidl(lPtr)
            vInfo = Array(vbNullString, vbNullString, vbNullString, 0, 0, 0, 0)
            '--- get DeviceName
            Set pDataObject = Nothing
            Call m_pPrintersFolder.GetUIObjectOf(0, 1, VarPtr(pidlCurrent(0)), IID_IDataObject(0), 0, pDataObject)
            vInfo(ucsIdxDeviceName) = pvGetDeviceName(pDataObject)
            If SearchCollection(m_cPrinters, vInfo(ucsIdxDeviceName)) Then
            If LenB(vInfo(ucsIdxDeviceName)) <> 0 Then
                '--- get tooltip
                If bTooltip Then
                    Set pQueryInfo = Nothing
                    '--- note: win98 ne poddyrja IID_IQueryInfo
                    On Error Resume Next '--- checked
                    Call m_pPrintersFolder.GetUIObjectOf(0, 1, VarPtr(pidlCurrent(0)), IID_IQueryInfo(0), 0, pQueryInfo)
                    On Error GoTo EH
                    If Not pQueryInfo Is Nothing Then
                        lPtr = 0
                        On Error Resume Next '--- checked
                        Call pQueryInfo.GetInfoTip(QITIPF_SINGLELINE, lPtr)
                        On Error GoTo EH
                        If lPtr <> 0 Then
                            vInfo(ucsIdxToolTip) = Replace(Replace(Replace(Replace(Replace(SysAllocString(lPtr), vbCrLf, ", "), vbLf, ", "), vbTab, vbNullString), "  ", " "), "  ", " ")
                            Call CoTaskMemFree(lPtr)
                        End If
                    End If
                End If
                '--- combine pidls: Printers + Current
                ReDim pidlAbsolute(0 To UBound(m_pidlPrinters) + UBound(pidlCurrent)) As Byte
                Call CopyMemory(pidlAbsolute(0), m_pidlPrinters(0), UBound(m_pidlPrinters) - 1)
                Call CopyMemory(pidlAbsolute(UBound(m_pidlPrinters) - 1), pidlCurrent(0), UBound(pidlCurrent) - 1)
                '--- retrieve info
                vInfo(ucsIdxLargeImageList) = SHGetFileInfo(pidlAbsolute(0), 0, VarPtr(uInfo), LenB(uInfo), SHGFI_PIDL Or SHGFI_DISPLAYNAME Or SHGFI_SYSICONINDEX Or SHGFI_LARGEICON Or SHGFI_SHELLICONSIZE)
                vInfo(ucsIdxDisplayName) = Left$(uInfo.szDisplayName, InStr(uInfo.szDisplayName, vbNullChar) - 1)
                vInfo(ucsIdxLargeIconIndex) = uInfo.iIcon
                vInfo(ucsIdxSmallImageList) = SHGetFileInfo(pidlAbsolute(0), 0, VarPtr(uInfo), LenB(uInfo), SHGFI_PIDL Or SHGFI_SYSICONINDEX Or SHGFI_SMALLICON Or SHGFI_SHELLICONSIZE)
                vInfo(ucsIdxSmallIconIndex) = uInfo.iIcon
                If pvUpdateCollection(m_cPrinters, vInfo) Then
                    pvUpdatePrinterInfo = True
                    '--- repaint dropdown
                    If bTooltip And Not m_oCtl Is Nothing Then
                        If m_oCtl.DropDown Then
                            If m_cxLarge = 0 Then
                                Call ImageList_GetIconSize(vInfo(ucsIdxLargeImageList), m_cxLarge, m_cyLarge)
                                Call ImageList_GetIconSize(vInfo(ucsIdxSmallImageList), m_cxSmall, m_cySmall)
                            End If
                            Call GetClientRect(m_oCtl.hDropdown, rc)
                            Call InvalidateRect(m_oCtl.hDropdown, rc, 0)
                            DoEvents
                            If m_oCtl Is Nothing Then
                                pvUpdatePrinterInfo = False
                                GoTo QH
                            End If
                        End If
                    End If
                End If
            End If
            End If
        Loop
        If m_cPrinters.Count > 0 Then
            Call ImageList_GetIconSize(m_cPrinters.Item(1)(ucsIdxLargeImageList), m_cxLarge, m_cyLarge)
            Call ImageList_GetIconSize(m_cPrinters.Item(1)(ucsIdxSmallImageList), m_cxSmall, m_cySmall)
        End If
    End If
    '--- min size: 32px in small fonts, 40px in large-font
    m_lIndent = 480 / ScreenTwipsPerPixelX
    If m_cxLarge > m_lIndent Then
        m_lIndent = m_cxLarge
    End If
    m_oCtl_MeasureItem 0, lItemHeight
    '--- ednokratno, inache combo-to se bugqswa vert scrollbar
    If m_oCtl.ItemHeight(0) < lItemHeight Then
        m_oCtl.DropdownRows = m_oForm.ScreenPhysicalHeight / lItemHeight \ 2
    End If
QH:
    m_bInUpdatePrinterInfo = False
    Exit Function
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Function

Private Function pvCalcMaxWidth(cPrinters As Collection) As Long
    Const FUNC_NAME     As String = "pvCalcMaxWidth"
    Dim vElem       As Variant
    Dim oFontDC     As cMemDC
    Dim hPrevFont   As Long
    Dim lWidth      As Long
    
    On Error GoTo EH
    pvCalcMaxWidth = -1
    If cPrinters.Count > 0 Then
        If InitFontDC(RetVal:=oFontDC) Is Nothing Then
        Else
            hPrevFont = SelectObject(oFontDC.hDC, m_pBoldFont.hFont)
        End If
        For Each vElem In cPrinters
            If Not oFontDC Is Nothing Then
                Call SelectObject(oFontDC.hDC, m_pBoldFont.hFont)
                lWidth = oFontDC.TextWidth(vElem(ucsIdxDisplayName)) + 8 + m_lIndent + 8
            Else
                lWidth = Len(vElem(ucsIdxDisplayName)) * m_pBoldFont.Size / 2 + 8 + m_lIndent + 8
            End If
            If lWidth > pvCalcMaxWidth Then
                pvCalcMaxWidth = lWidth
            End If
            If Not oFontDC Is Nothing Then
                Call SelectObject(oFontDC.hDC, m_pItalicFont.hFont)
                lWidth = 10 + oFontDC.TextWidth(vElem(ucsIdxToolTip)) + 8 + m_lIndent + 8
            Else
                lWidth = 10 + Len(vElem(ucsIdxToolTip)) * m_pItalicFont.Size / 2 + 8 + m_lIndent + 8
            End If
            If lWidth > pvCalcMaxWidth Then
                pvCalcMaxWidth = lWidth
            End If
        Next
        If Not oFontDC Is Nothing Then
            Call SelectObject(oFontDC.hDC, hPrevFont)
        End If
        pvCalcMaxWidth = pvCalcMaxWidth + GetSystemMetrics(SM_CXVSCROLL)
    End If
    Exit Function
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Function

Private Function pvToPidl(ByVal lPtr As Long, Optional ByVal Release As Boolean = True) As Byte()
    Dim lTotal      As Long
    Dim nSize       As Integer
    Dim baRetVal()  As Byte
    
    If lPtr <> 0 Then
        Do
            Call CopyMemory(nSize, ByVal UnsignedAdd(lPtr, lTotal), 2)
            lTotal = lTotal + nSize
        Loop While nSize <> 0
        ReDim baRetVal(0 To lTotal + 1) As Byte
        Call CopyMemory(baRetVal(0), ByVal lPtr, lTotal + 2)
        If Release Then
            Call CoTaskMemFree(lPtr)
        End If
    Else
        ReDim baRetVal(0 To 1) As Byte
    End If
    pvToPidl = baRetVal
End Function

'=========================================================================
' Control events
'=========================================================================

Private Sub m_oCtl_Click()
    Const FUNC_NAME     As String = "m_oCtl_Click"
    
    On Error GoTo EH
    m_oCtl_Change
    Exit Sub
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Sub

Private Sub m_oCtl_Change()
    Const FUNC_NAME     As String = "m_oCtl_Change"
    Dim rc              As RECT
    
    On Error GoTo EH
    If Not m_bEnabled Then
        Exit Sub
    End If
    If m_oCtl.DropDown Then
        Call GetClientRect(m_oCtl.hDropdown, rc)
        Call InvalidateRect(m_oCtl.hDropdown, rc, 0)
    End If
    Exit Sub
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Sub

Private Sub m_oCtl_DropDown()
    Const FUNC_NAME     As String = "m_oCtl_DropDown"
    
    On Error GoTo EH
    If m_bEnabled Then
        pvTimerAction(ucsTmrUpdateStatus) = True '--- moje i ucsTmrDelayUpdateStatus
    End If
    Exit Sub
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Sub

Private Sub m_oCtl_CloseUp()
    Const FUNC_NAME     As String = "m_oCtl_CloseUp"
    
    On Error GoTo EH
    If m_bEnabled Then
        pvTimerAction(ucsTmrUpdateStatus Or ucsTmrDelayUpdateStatus) = False
        m_oCtl.ColumnWidths(c_Text) = pvCalcMaxWidth(m_cPrinters)
    End If
    Exit Sub
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Sub

Private Sub m_oCtl_MeasureItem(ItemID As Long, ItemHeight As Long)
    Const FUNC_NAME     As String = "m_oCtl_MeasureItem"
    
    On Error GoTo EH
    If Not m_bEnabled Then
        If ItemID >= 0 Then
            ItemHeight = m_lOrigItemHeight
        End If
    Else
        If ItemID < 0 Then
            If m_oCtl.Style = b2kDropdownList Then
                If ItemHeight < m_cySmall Then
                    ItemHeight = m_cySmall
                End If
            End If
        Else
            If m_lIndent + 8 > m_lOrigItemHeight * 2 Then
                ItemHeight = m_lIndent + 8
            Else
                ItemHeight = m_lOrigItemHeight * 2
            End If
        End If
    End If
    Exit Sub
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Sub

Private Sub m_oCtl_DrawItem(ItemID As Long, ColIndex As Long, hDC As Long, Left As Long, Top As Long, Right As Long, Bottom As Long)
    Const FUNC_NAME     As String = "m_oCtl_DrawItem"
    Dim vElem           As Variant
    Dim oMemDC          As cMemDC
    Dim hPrevFont       As Long
    Dim rcFocus         As RECT
    Dim bSelected       As Boolean
    Dim rc              As RECT
    Dim bEnabled        As Boolean
    
    On Error GoTo EH
    If Not m_bEnabled Or ColIndex <> c_Text Then
        Exit Sub
    End If
    If SearchCollection(m_cPrinters, IIf(ItemID < 0, m_oCtl.Text, m_oCtl.Item(c_Text, ItemID)), RetVal:=vElem) Then
        If InitMemDC(hMemoryDC:=hDC, RetVal:=oMemDC) Is Nothing Then
            Exit Sub
        End If
        oMemDC.BackStyle = BS_TRANSPARENT
        rcFocus.Top = Top
        rcFocus.Right = Right - 1
        rcFocus.Bottom = Bottom
        bEnabled = Not HwndStyle(m_oCtl.hWnd, WS_DISABLED)
        If Bottom - Top < m_lIndent + 8 Then
            If Not bEnabled Then
                rc.Left = Left
                rc.Top = Top
                rc.Right = Right
                rc.Bottom = Bottom
                Call FillRect(oMemDC.hDC, rc, SendMessage(GetParent(m_oCtl.hWnd), WM_CTLCOLORBTN, oMemDC.hDC, ByVal m_oCtl.hWnd))
            Else
                oMemDC.FillRect Left, Top, Left + m_lIndent + 6, Bottom, IIf(bEnabled, m_oCtl.BackColor, vbButtonFace)
                If Not m_oCtl.DropDown And GetFocus() = m_oCtl.hWndCombo Then
                    bSelected = True
                    oMemDC.FillRect Left + m_lIndent + 6, Top, Right, Bottom, vbHighlight
                    rcFocus.Left = Left + m_lIndent + 6
                    rcFocus.Right = Right
                    Call DrawFocusRect(hDC, rcFocus)
                Else
                    oMemDC.FillRect Left + m_lIndent + 6, Top, Right, Bottom, IIf(bEnabled, m_oCtl.BackColor, vbButtonFace)
                End If
            End If
            hPrevFont = SelectObject(hDC, m_pNormalFont.hFont)
            oMemDC.ForeColor = IIf(bEnabled, IIf(bSelected, vbHighlightText, m_oCtl.ForeColor), vbButtonShadow)
            oMemDC.DrawText C_Str(vElem(ucsIdxDisplayName)), Left + m_lIndent + 6 + 4, Top, Right, Bottom, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER Or DT_NOPREFIX
            If bEnabled Then
                Call ImageList_Draw(vElem(ucsIdxSmallImageList), vElem(ucsIdxSmallIconIndex), hDC, Left + (m_lIndent + 6 - m_cxSmall) \ 2, Top + (Bottom - Top - m_cySmall) \ 2, ILD_TRANSPARENT Or -bSelected * ILD_BLEND25)
            Else
                Call ImageList_DrawEx(vElem(ucsIdxSmallImageList), vElem(ucsIdxSmallIconIndex), hDC, Left + (m_lIndent + 6 - m_cxSmall) \ 2, Top + (Bottom - Top - m_cySmall) \ 2, 0, 0, -1, oMemDC.TranslateColor(vbButtonFace), ILD_TRANSPARENT Or ILD_BLEND50)
            End If
        Else
            oMemDC.FillRect Left, Top, Left + m_lIndent + 8, Bottom, m_oCtl.BackColor
            If m_oCtl.SelectIndex = ItemID Then
                bSelected = True
                oMemDC.FillRect Left + m_lIndent + 8, Top, Right, Bottom, vbHighlight
                rcFocus.Left = Left + m_lIndent + 8
                Call DrawFocusRect(hDC, rcFocus)
            Else
                oMemDC.FillRect Left + m_lIndent + 8, Top, Right, Bottom, m_oCtl.BackColor
            End If
            hPrevFont = SelectObject(hDC, IIf(m_oCtl.ListIndex = ItemID, m_pBoldFont.hFont, m_pNormalFont.hFont))
            oMemDC.ForeColor = IIf(bSelected, vbHighlightText, m_oCtl.ForeColor)
            If LenB(vElem(ucsIdxToolTip)) = 0 Then
                oMemDC.DrawText C_Str(vElem(ucsIdxDisplayName)), Left + m_lIndent + 8 + 4, Top, Right, Bottom, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER Or DT_NOPREFIX
            Else
                oMemDC.DrawText C_Str(vElem(ucsIdxDisplayName)), Left + m_lIndent + 8 + 4, Top, Right, Top + (Bottom - Top) \ 2, DT_SINGLELINE Or DT_LEFT Or DT_BOTTOM Or DT_NOPREFIX
                Call SelectObject(hDC, m_pItalicFont.hFont)
                oMemDC.ForeColor = IIf(bSelected, vbHighlightText, IIf(m_oCtl.ListIndex = ItemID, m_oCtl.ForeColor, vbButtonShadow))
                oMemDC.DrawText CStr(vElem(ucsIdxToolTip)), Left + m_lIndent + 8 + 4 + 10, Top + (Bottom - Top) \ 2 + 1, Right, Bottom, DT_SINGLELINE Or DT_LEFT Or DT_TOP Or DT_NOPREFIX
            End If
            Call ImageList_Draw(vElem(ucsIdxLargeImageList), vElem(ucsIdxLargeIconIndex), hDC, Left + (m_lIndent + 8 - m_cxLarge) \ 2, Top + (Bottom - Top - m_cyLarge) \ 2, ILD_TRANSPARENT Or -bSelected * ILD_BLEND25)
        End If
        Call SelectObject(hDC, hPrevFont)
        oMemDC.SetClipRect 0
    End If
    Exit Sub
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Sub

Private Sub Class_Initialize()
    Const FUNC_NAME     As String = "Class_Initialize"

    On Error GoTo EH
    #If DebugMode Then
        DebugInstanceInit STR_MODULE_NAME, m_sDebugID, Me
    #End If
    '--- init IIDs
    IID_IShellFolder(0) = &H214E6 '--- {000214E6-0000-0000-C000-000000000046}
    IID_IShellFolder(2) = &HC0
    IID_IShellFolder(3) = &H46000000
    IID_IQueryInfo(0) = &H21500 '--- {00021500-0000-0000-c000-000000000046}
    IID_IQueryInfo(2) = &HC0
    IID_IQueryInfo(3) = &H46000000
    IID_IDataObject(0) = &H10E '--- 0000010e-0000-0000-C000-000000000046
    IID_IDataObject(2) = &HC0
    IID_IDataObject(3) = &H46000000
    Exit Sub
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Sub
    
#If DebugMode Then
    Private Sub Class_Terminate()
        DebugInstanceTerm STR_MODULE_NAME, m_sDebugID
    End Sub
#End If

'=========================================================================
' IUcsTerminate interface
'=========================================================================

Private Sub IUcsTerminate_QueryTerminate(Cancel As Boolean)

End Sub

Private Sub IUcsTerminate_Terminate()
    Const FUNC_NAME     As String = "IUcsTerminate_Terminate"
    
    On Error GoTo EH
    #If DebugMode Then
        DebugInstanceName frInstanceName & " terminated", m_sDebugID
    #End If
    TerminateSubclassingThunk m_pSubclass, Me
    Set m_pCleanupNotify = Nothing
    TerminateFireOnceTimerThunk m_pTimer, Me
    m_eTimerAction = 0
    Set m_oForm = Nothing
    Set m_oCtl = Nothing
    Exit Sub
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Sub

This seems like what I'm looking for in terms of displaying a combo with the name of all printers with their associated shell icons. But I can't figure out how to use this. Do you have a VB6 demo project showing its usage?

No I don't. This is using an internal owner-drawn combobox control for the actual painting of which can't find suitable replacement.

I'm linking in post this only for the enumeration part which resolves a bug in VB's Printers collection seeing printers from all logged in users (which is annoying under Terminal Servers).