Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0410: Erweiterte Druckerinfos erhalten

VB 5/6-Tipp 0410: Erweiterte Druckerinfos erhalten

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GetDeviceCaps

Download: Download des Beispielprojektes [2,36 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"

Option Explicit

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc _
        As Long, ByVal nIndex As Long) As Long

Const DT_PLOTTER As Long = &H0&
Const DT_RASDISPLAY As Long = &H1&
Const DT_RASPRINTER As Long = &H2&
Const DT_RASCAMERA As Long = &H3&
Const DT_CHARSTREAM As Long = &H4&
Const DT_METAFILE As Long = &H5&
Const DT_DISPFILE As Long = &H6&

Const DRIVERVERSION As Long = &H0&
Const TECHNOLOGY As Long = &H2&
Const HORZSIZE As Long = &H4&
Const VERTSIZE As Long = &H6&
Const HORZRES As Long = &H8&
Const VERTRES As Long = &HA&
Const NUMBRUSHES As Long = &H10&
Const NUMPENS As Long = &H12&
Const NUMCOLORS As Long = &H18&
Const LOGPIXELSX As Long = &H58&
Const LOGPIXELSY As Long = &H5A&

Private Sub GetPrinterInfo()
    Dim x As Long, pDc As Long
    
    Text1.Text = ""
    
    pDc = Printer.hdc
    TX (Printer.DeviceName)
    TX ("------------------------------------")
    
    x = GetDeviceCaps(pDc, TECHNOLOGY)
    Select Case x
        Case DT_PLOTTER:    Call TX("TECHNOLOGY=PLOTTER")
        Case DT_RASDISPLAY: Call TX("TECHNOLOGY=RASDISPLAY")
        Case DT_RASPRINTER: Call TX("TECHNOLOGY=RASPRINTER")
        Case DT_RASCAMERA:  Call TX("TECHNOLOGY=RASCAMERA")
        Case DT_CHARSTREAM: Call TX("TECHNOLOGY=CHARSTREAM")
        Case DT_METAFILE:   Call TX("TECHNOLOGY=METAFILE")
        Case DT_DISPFILE:   Call TX("TECHNOLOGY=DISPFILE")
    End Select
    
    TX ("DRIVERVERSION=" & GetDeviceCaps(pDc, DRIVERVERSION))
    TX (" ")
    
    TX ("Width in mm =" & GetDeviceCaps(pDc, HORZSIZE))
    TX ("Height in mm=" & GetDeviceCaps(pDc, VERTSIZE))
    TX (" ")
    
    TX ("Width in Px =" & GetDeviceCaps(pDc, HORZRES))
    TX ("Height in Px=" & GetDeviceCaps(pDc, VERTRES))
    TX (" ")
    
    TX ("DPI in X=" & GetDeviceCaps(pDc, LOGPIXELSX))
    TX ("DPI in Y=" & GetDeviceCaps(pDc, LOGPIXELSY))
    TX (" ")
    
    TX ("Brushes=" & GetDeviceCaps(pDc, NUMBRUSHES))
    TX ("Pens=" & GetDeviceCaps(pDc, NUMPENS))
    TX ("Colors=" & GetDeviceCaps(pDc, NUMCOLORS))
End Sub

Private Sub TX(Optional Text As String, Optional V As String)
    If Len(Text) > 0 Then
        Text1.Text = Text1.Text & Text & vbCrLf
    End If
  
    If Len(V) > 0 Then
        Text1.Text = Text1.Text & V & vbCrLf
    End If
End Sub

Private Sub Command1_Click()
    Call GetPrinterInfo
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------