Ejemplos usando el Api de windows para Visual basic

247 - Obtener configuración de la impresora

Ejemplo para obtener información de la impresora del sistema mediante el Api de windows

El ejemplo lista en un ListBox algunos datos como por ejemplo el nombre de la impresora, la orientación del papel, la resolución, y algunas otras. Toda esta info la devuelve la estructura DEVMODE, y también se pueden consultar otros datos a parte de los que lista el ejemplo, mediante esta estructura

formulario con los datos de la impresora

Código fuente en el formulario con un control Listbox y un commandbutton

'''''''''''''''''''''''''''''''''''''''''''''''''''' 'Autor : Microsoft '''''''''''''''''''''''''''''''''''''''''''''''''''' Option Explicit Private Const NULLPTR = 0& ' Constants for DEVMODE Private Const CCHDEVICENAME = 32 Private Const CCHFORMNAME = 32 ' Constants for DocumentProperties Private Const DM_MODIFY = 8 Private Const DM_COPY = 2 Private Const DM_IN_BUFFER = DM_MODIFY Private Const DM_OUT_BUFFER = DM_COPY ' Constants for dmOrientation Private Const DMORIENT_PORTRAIT = 1 Private Const DMORIENT_LANDSCAPE = 2 ' Constants for dm Print Quality Private Const DMRES_DRAFT = (-1) Private Const DMRES_HIGH = (-4) Private Const DMRES_LOW = (-2) Private Const DMRES_MEDIUM = (-3) ' Constants for dmTTOption Private Const DMTT_BITMAP = 1 Private Const DMTT_DOWNLOAD = 2 Private Const DMTT_DOWNLOAD_OUTLINE = 4 Private Const DMTT_SUBDEV = 3 ' Constants for dmColor Private Const DMCOLOR_COLOR = 2 Private Const DMCOLOR_MONOCHROME = 1 Private Type DEVMODE dmDeviceName(1 To CCHDEVICENAME) As Byte dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName(1 To CCHFORMNAME) As Byte dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" ( _ ByVal pPrinterName As String, _ phPrinter As Long, _ ByVal pDefault As Long) As Long Private Declare Function DocumentProperties Lib "winspool.drv" Alias _ "DocumentPropertiesA" ( _ ByVal hwnd As Long, _ ByVal hPrinter As Long, _ ByVal pDeviceName As String, _ pDevModeOutput As Any, _ pDevModeInput As Any, _ ByVal fMode As Long) As Long Private Declare Function ClosePrinter Lib "winspool.drv" ( _ ByVal hPrinter As Long) As Long Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" ( _ hpvDest As Any, _ hpvSource As Any, _ ByVal cbCopy As Long) Function StripNulls(OriginalStr As String) As String If (InStr(OriginalStr, Chr(0)) > 0) Then OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1) End If StripNulls = Trim(OriginalStr) End Function Function ByteToString(ByteArray() As Byte) As String Dim TempStr As String Dim I As Integer For I = 1 To CCHDEVICENAME TempStr = TempStr & Chr(ByteArray(I)) Next I ByteToString = StripNulls(TempStr) End Function ' función que agrega en el ListBox la _ configuración de la impresora del sistema '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function GetPrinterSettings(szPrinterName As String, _ hdc As Long, _ ListBox As ListBox) As Boolean Dim hPrinter As Long Dim nSize As Long Dim pDevMode As DEVMODE Dim aDevMode() As Byte Dim TempStr As String If OpenPrinter(szPrinterName, hPrinter, NULLPTR) Then nSize = DocumentProperties(NULLPTR, hPrinter, szPrinterName, NULLPTR, NULLPTR, 0) ReDim aDevMode(1 To nSize) nSize = DocumentProperties(NULLPTR, hPrinter, szPrinterName, _ aDevMode(1), NULLPTR, DM_OUT_BUFFER) Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode)) With ListBox .Clear ' Limpia el Listbox ' añade el nombre de la impresora .AddItem "Printer Name: " & ByteToString(pDevMode.dmDeviceName) ' orientación de la Hoja ''''''''''''''''''''''''' If pDevMode.dmOrientation = DMORIENT_PORTRAIT Then TempStr = "PORTRAIT" ElseIf pDevMode.dmOrientation = DMORIENT_LANDSCAPE Then TempStr = "LANDSCAPE" Else TempStr = "UNDEFINED" End If .AddItem "Orientación del papel: " & TempStr ' calidad de impresión establecida '''''''''''''''''''''''''''''''''''''''''''' Select Case pDevMode.dmPrintQuality Case DMRES_DRAFT TempStr = "DRAFT" Case DMRES_HIGH TempStr = "HIGH" Case DMRES_LOW TempStr = "LOW" Case DMRES_MEDIUM TempStr = "MEDIUM" Case Else ' positive value TempStr = CStr(pDevMode.dmPrintQuality) & " dpi" End Select .AddItem "Calidad de impresión: " & TempStr Select Case pDevMode.dmTTOption ' default for dot-matrix printers Case DMTT_BITMAP TempStr = "TrueType fonts as graphics" ' default for HP printers that use PCL Case DMTT_DOWNLOAD TempStr = "Downloads TrueType fonts as soft fonts" Case DMTT_SUBDEV ' default for PostScript printers TempStr = "Substitute device fonts for TrueType fonts" Case Else TempStr = "UNDEFINED" End Select .AddItem "TrueType Option: " & TempStr ' Usa color o en blanco y negro '''''''''''''''''''''''''''''''''''''''''''' ' Windows NT drivers often return COLOR from Monochrome printers If pDevMode.dmColor = DMCOLOR_MONOCHROME Then TempStr = "MONOCHROME" ElseIf pDevMode.dmColor = DMCOLOR_COLOR Then TempStr = "COLOR" Else TempStr = "UNDEFINED" End If .AddItem "Color or Monochrome: " & TempStr If pDevMode.dmScale = 0 Then TempStr = "NONE" Else TempStr = CStr(pDevMode.dmScale) End If ' factor de escala de impresión .AddItem "Zoom: " & TempStr .AddItem "Resolución: " & pDevMode.dmYResolution & " dpi" ' copias .AddItem "Copias: " & CStr(pDevMode.dmCopies) End With Call ClosePrinter(hPrinter) GetPrinterSettings = True Else GetPrinterSettings = False End If End Function Private Sub Command1_Click() Dim ret As Boolean ret = GetPrinterSettings(Printer.DeviceName, Printer.hdc, List1) If ret = False Then MsgBox "No se pudo obtener la configuración de la impresora" End If End Sub Private Sub Form_Load() Command1.Caption = "Obtener configuración" End Sub

Recursos visual basic - Enlaces relacionados

Ejemplos relacionados a impresión / Impresora

Buscar en Recursos vb