Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0498: Auslesen der Grafikeinstellungen

VB 5/6-Tipp 0498: Auslesen der Grafikeinstellungen

 von Konrad Rudolph

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GetDC, GetDeviceCaps, ReleaseDC

Download: Download des Beispielprojektes [2,03 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  ---------

Option Explicit

' Grafik
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
                         ByVal hDC As Long, _
                         ByVal nIndex As Long) As Long
                         
Private Declare Function GetDC Lib "user32" ( _
                         ByVal hwnd As Long) As Long
                         
Private Declare Function ReleaseDC Lib "user32" ( _
                         ByVal hwnd As Long, _
                         ByVal hDC As Long) As Long
                         
Private Sub form_load()
    Dim ResultString As String
    Dim Auflösung As String
    Dim Farbtiefe As String
    Dim hDC As Long
    Dim cPixels As Long
    Dim lResult As Long
    
    Const BITSPIXEL = 12
    Const PLANES = 14
    
    ' BS-Auflösung
    Auflösung = CStr(Screen.Width / Screen.TwipsPerPixelX) & "x" & CStr(Screen.Height / _
        Screen.TwipsPerPixelY)
        
    ' Farbtiefe
    hDC = GetDC(0)
    cPixels = GetDeviceCaps(hDC, BITSPIXEL) * GetDeviceCaps(hDC, PLANES)
    lResult = ReleaseDC(0, hDC)
    
    Select Case cPixels
    
    Case 1
        Farbtiefe = "Monochrom"
    Case 4
        Farbtiefe = "16 Farben"
    Case 8
        Farbtiefe = "256 Farben"
    Case 16
        Farbtiefe = "HighColor, " & CStr(cPixels) & "-Bit Farben"
    Case 24
        Farbtiefe = "HighColor, " & CStr(cPixels) & "-Bit Farben"
    Case 32
        Farbtiefe = "TrueColor, " & CStr(cPixels) & "-Bit Farben"
    End Select
    
    ' Ausgabe
    ResultString = "Anzeige -" & vbCrLf & vbTab & " Bildschirmauflösung " & vbTab & _
        Auflösung & vbCrLf & vbTab & " Farbeinstellung     " & vbTab & vbTab & Farbtiefe
        
    MsgBox ResultString, vbOKOnly + vbInformation, "Grafikinfo"
    Unload Me
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------