2009-06-30 4 views
4

J'essaie d'émuler la liste déroulante de sélection d'imprimante de la boîte de dialogue d'impression MS Office. La liste déroulante contient les noms des imprimantes avec de grandes icônes d'imprimante à gauche. Sur Vista imprimante de fax a une belle icône de télécopie, les imprimantes partagées sont marquées, l'imprimante par défaut aussi. Le mieux serait d'être en mesure d'afficher plus d'informations sur l'imprimante, comme l'explorateur affiche le Panneau de configuration-> Imprimantes.Récupération des icônes des imprimantes utilisateur en cours

Des idées par où commencer?

Avait un succès modéré avec SHGetFileInfo mais votre opinion est la bienvenue.

[: Windows, code de la langue: tout]

Répondre

4

Voici ce que je finalement trouvé. Vous aurez besoin de IShellFolder Extended Type Library v1.2 pour les différentes interfaces OLE. Je suis positif que typelib peut être porté d'une meilleure manière à VB6 mais de toute façon voici le résultat:

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 
0

\ 'est facile et classique en C/Win32 (voir Win32 grp, code source Explorer à partir de MS interne)

+0

Que voulez-vous dire? Pouvez-vous donner un lien direct à la publication? – wqw

0

Vous ne dites pas comment vous appelez SHGetFileInfo, mais je suppose que vous devez définir l'indicateur de SHGFI_PIDL et utiliser une icônes PIDL complet (et peut-être SHGFI_USEFILEATTRIBUTES)

pour obtenir shared/recouvrement par défaut, définissez l'indicateur SHGFI_ADDOVERLAYS

+0

Oui, obtenir les PIDL était la douleur. Surtout en VB6 – wqw

Questions connexes