Ответить

На данный момент поняла только, что нужно использовать DeviceCapabilities с параметром DC_PAPERNAMES (DC_PAPERS). Верно? Программу еще не соорудила, поэтому за пример буду крайне благодарна, свой e-mail Вам выслала.

Ответить

За dll спасибо. Мне было интересно увидеть код. Кидаю свой, если кому-то тоже будет интересно.

Private Type POINTL
   x As Long
   y As Long
End Type

Public Const GERMAN_HEIGHT = 3048 'Высота бумаги "Фальцованная стандартная (Германия)"
Public Const GERMAN_WIDTH = 2159  'Ширина бумаги "Фальцованная стандартная (Германия)"
Public Const A4_HEIGHT = 2970     'Высота бумаги "A4"
Public Const A4_WIDTH = 2100      'Ширина бумаги "A4"

Private Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, ByVal lpPort As String, ByVal iIndex As Long, ByRef lpOutput As Any, ByVal lpDevMode As Long) As Long

Public Function GetPaperSizes(ByVal psDeviceName As String, _
                              ByRef paIPaperSizesIndexes() As Integer, _
                              ByRef paSPaperSizesNames() As String, _
                              ByRef paUPaperSizes() As POINTL) _
                As Boolean
'
'  Возвращает индексы, наименования и размеры (ширин и высоту)
'  поддерживаемых принтером размеров бумаги в массивах-параметрах.
'
   Dim OPrinter         As Printer 'Заданный принтер
   Dim j1               As Long    'Счетчик цикла
   Dim lBinsCount       As Long    'Число источников бумаги
   Dim lPos             As Long    'Позиция подстроки
   Dim lSizesCount      As Long    'Число поддерживаемых размеров бумаги
   Dim sBinName         As String  'Текущее наименование источника бумаги
   Dim sBinNamesList    As String  'Список наименований источников бумаги
   Dim sDevicePort      As String  'Порт заданного принтера
   Dim sPaperName       As String  'Текущее наименование размера бумаги
   Dim sPaperNamesList  As String  'Список наименований поддерживаемых размеров бумаги

   For Each OPrinter In Printers
       If OPrinter.DeviceName = psDeviceName Then Exit For
   Next OPrinter
   
   On Error GoTo ErrorHandler
  
   'Получим число поддерживаемых принтером размеров бумаги
   sDevicePort = OPrinter.Port
   lSizesCount = DeviceCapabilities(psDeviceName, _
                    sDevicePort, DC_PAPERNAMES, _
                    ByVal vbNullString, 0)
   
   'Переопределим массивы для получения поддерживаемых размеров бумаги
   ReDim paUPaperSizes(0 To lSizesCount - 1) As POINTL
   ReDim paIPaperSizesIndexes(0 To lSizesCount - 1) As Integer
   ReDim paSPaperSizesNames(0 To lSizesCount - 1) As String
  
   'Получим массив номеров поддерживаемых принтером размеров бумаги
   lSizesCount = DeviceCapabilities(psDeviceName, _
                    sDevicePort, DC_PAPERS, _
                    paIPaperSizesIndexes(0), 0)
  
   'Получим строку наименований поддерживаемых принтером размеров бумаги
   sPaperNamesList = String(lSizesCount * 64, 0)
   lSizesCount = DeviceCapabilities(psDeviceName, _
                    sDevicePort, DC_PAPERNAMES, _
                    ByVal sPaperNamesList, 0)

   'Разнесем наименования из строки в массив
   For j1 = 1 To lSizesCount
       sPaperName = Mid(sPaperNamesList, ((j1 - 1) * 64 + 1), 64)
       lPos = InStr(1, sPaperName, Chr(0))
       paSPaperSizesNames(j1 - 1) = Left(sPaperName, lPos - 1)
   Next
  
   'Получим массив с шириной и высотой для каждого из размеров бумаги
   lSizesCount = DeviceCapabilities(psDeviceName, _
                     sDevicePort, DC_PAPERSIZE, _
                     paUPaperSizes(0), 0)
  
   GetPaperSizes = True
   On Error GoTo 0
   Exit Function

ErrorHandler:
   Debug.Print "GetPaperSizes: Ошибка " & Err.Number & " - " & Err.Description
   Err.Clear
   On Error GoTo 0
   GetPaperSizes = False

End Function

Ответить