Zjištění podavačů tiskárny

Postup:
Založte nový projekt, na formulář přidejte tlačítko a TextBox, kterému nastavte MultiLine = True a Scrolsbar = vertical. Do deklarační části formuláře zapište:
Option Explicit

Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal dev As Long) As Long

Private Const DC_BINS = 6
Private Const DC_BINNAMES = 12

Na událost Click tlačítka zapište:
Private Sub Command1_Click()

   Dim prn As Printer
   Dim dwbins As Long
   Dim ct As Long
   Dim nameslist As String
   Dim nextString As String
   Dim numBin() As Integer

   Text1.Font.Name = "Courier New"
   Text1.Font.Size = 12
   Text1.Text = ""

   For Each prn In Printers
      dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
         DC_BINS, ByVal vbNullString, 0)
      ReDim numBin(1 To dwbins)
      nameslist = String(24 * dwbins, 0)
      dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
         DC_BINS, numBin(1), 0)
      dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
         DC_BINNAMES, ByVal nameslist, 0)
      If Text1.Text <> "" Then
         Text1.Text = Text1.Text & vbCrLf & vbCrLf
      End If
      Text1.Text = Text1.Text & prn.DeviceName
      For ct = 1 To dwbins
         nextString = Mid(nameslist, 24 * (ct - 1) + 1, 24)
         nextString = Left(nextString, InStr(1, nextString, _
            Chr(0)) - 1)
         nextString = String(6 - Len(CStr(numBin(ct))), " ") & _
            numBin(ct) & " " & nextString
         Text1.Text = Text1.Text & vbCrLf & nextString
      Next ct
   Next prn

End Sub

Spusťte projekt - po kliknutí na tlačítko se do TextBoxu vypíšou zásobníky pro všechny nainstalované tiskárny. Upozorňuji, že ne všechny vypsané zásobníky musí být přístupné, některé typy tiskáren vrací i nenainstalovaná zařízení.

Zpět