检索当前用户打印机的图标 [英] Retrieving icons of current user printers

问题描述

我正在尝试模拟MS Office打印对话框的打印机选择组合框。下拉列表包含左侧有大型打印机图标的打印机名称。在Vista传真打印机有一个很好的传真图标，共享打印机被标记，默认打印机也是。最好的是能够查看更多打印机信息，例如资源管理器查看控制面板 - >打印机。

I'm trying to emulate MS Office print dialog's printer selection combobox. The drop-down list contains printer names with large printer icons to the left. On Vista fax printer has a nice fax icon, shared printers are marked, default printer too. Best would be to be able to view some more printer info too, like explorer does viewing Control Panel->Printers.

任何想法从哪开始？

SHGetFileInfo 取得了一定的成功，但您的意见非常受欢迎。

Had moderate success with SHGetFileInfo but your opinion is most welcome.

[os：windows，code language：any]

[os: windows, code language: any]

推荐答案

这是我最终提出的。对于各种OLE接口，您需要 IShellFolder扩展类型库v1.2 。我很肯定这个类型库可以更好地移植到VB6，但无论如何这里的结果是：

Here is what I finally came up with. You'll need IShellFolder Extended Type Library v1.2 for the various OLE interfaces. I'm positive this typelib can be ported in a better way to VB6 but anyway here is the result:

Option Explicit

Private Const CSIDL_PRINTERS    As Long = &H4
Private Const SHGFI_PIDL        As Long = &H8
Private Const SHGFI_ICON        As Long = &H100
Private Const SHGFI_DISPLAYNAME As Long = &H200
Private Const MAX_PATH          As Long = 260

Private Declare Function SHGetDesktopFolder Lib "shell32" (ppshf As IShellFolder) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" (pszPath As Any, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, 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 OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PICTDESC, riid As Any, ByVal fPictureOwnsHandle As Long, ppRet As IPicture) As Long

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 PICTDESC
    Size                As Long
    Type                As Long
    hBmpOrIcon          As Long
    hPal                As Long
End Type

Private Sub Command1_Click()
    Dim IID_IShellFolder As IShellFolderEx_TLB.GUID
    Dim IID_IPicture(0 To 3) As Long
    Dim pidlPrinters()  As Byte
    Dim pidlCurrent()   As Byte
    Dim pidlAbsolute()  As Byte
    Dim pDesktopFolder  As IShellFolder
    Dim pPrintersFolder As IShellFolder
    Dim pEnumIds        As IEnumIDList
    Dim lPtr            As Long
    Dim uInfo           As SHFILEINFO
    Dim uPict           As PICTDESC
    Dim sPrinterName    As String
    Dim oPrinterIcon    As StdPicture

    '--- init consts
    IID_IShellFolder.Data1 = &H214E6 '--- {000214E6-0000-0000-C000-000000000046}
    IID_IShellFolder.Data4(0) = &HC0
    IID_IShellFolder.Data4(7) = &H46
    IID_IPicture(0) = &H7BF80980 '--- {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    IID_IPicture(1) = &H101ABF32
    IID_IPicture(2) = &HAA00BB8B
    IID_IPicture(3) = &HAB0C3000
    '--- init local vars
    uPict.Size = Len(uPict)
    uPict.Type = vbPicTypeIcon
    Call SHGetDesktopFolder(pDesktopFolder)
    '--- retrieve enumerator of Printers virtual folder
    Call SHGetSpecialFolderLocation(0, CSIDL_PRINTERS, lPtr)
    pidlPrinters = pvToPidl(lPtr)
    Call pDesktopFolder.BindToObject(VarPtr(pidlPrinters(0)), 0, IID_IShellFolder, pPrintersFolder)
    Call pPrintersFolder.EnumObjects(0, SHCONTF_NONFOLDERS, pEnumIds)
    '--- loop printers
    Do While pEnumIds.Next(1, lPtr, 0) = 0 '--- S_OK
        pidlCurrent = pvToPidl(lPtr)
        '--- combine pidls: Printers + Current
        ReDim pidlAbsolute(0 To UBound(pidlPrinters) + UBound(pidlCurrent))
        Call CopyMemory(pidlAbsolute(0), pidlPrinters(0), UBound(pidlPrinters) - 1)
        Call CopyMemory(pidlAbsolute(UBound(pidlPrinters) - 1), pidlCurrent(0), UBound(pidlCurrent) - 1)
        '--- retrieve info
        Call SHGetFileInfo(pidlAbsolute(0), 0, uInfo, Len(uInfo), SHGFI_PIDL Or SHGFI_DISPLAYNAME Or SHGFI_ICON)
        sPrinterName = Left(uInfo.szDisplayName, InStr(uInfo.szDisplayName, Chr$(0)) - 1)
        '--- extract icon
        uPict.hBmpOrIcon = uInfo.hIcon
        Call OleCreatePictureIndirect(uPict, IID_IPicture(0), True, oPrinterIcon)
        '--- show
        Set Picture = oPrinterIcon
        MsgBox sPrinterName
    Loop
End Sub

Private Function pvToPidl(ByVal lPtr As Long) As Byte()
    Dim lTotal      As Long
    Dim nSize       As Integer
    Dim baPidl()    As Byte

    Do
        Call CopyMemory(nSize, ByVal (lPtr + lTotal), 2)
        lTotal = lTotal + nSize
    Loop While nSize <> 0
    ReDim baPidl(0 To lTotal + 1)
    Call CopyMemory(baPidl(0), ByVal lPtr, lTotal + 2)
    Call CoTaskMemFree(lPtr)
    pvToPidl = baPidl
End Function

这篇关于检索当前用户打印机的图标的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！