How to get display adapter info using VB6

Posted on 2012-08-14
Last Modified: 2012-08-14
I want to run a VB6 program that determines the current display adapter (video card).  For example, if I go into Device Manager on my PC and look at my display adapter, it is called an NVIDIA GeForce GT 330.  How can I retrieve this info with VB6?
Question by:bpl5000
    LVL 44

    Accepted Solution

    Try this code which is modified from the API Guide.

    Option Explicit
           Dim d As DISPLAY_DEVICE
    Const CCDEVICENAME = 32
    Const CCFORMNAME = 32
    Const DM_PELSWIDTH = &H80000
    Const DM_PELSHEIGHT = &H100000
    Const CDS_TEST = &H4
    Private Type DISPLAY_DEVICE
        cb As Long
        DeviceName As String * 32
        DeviceString As String * 128
        StateFlags As Long
        DeviceID As String * 128
        DeviceKey  As String * 128
    End Type
    Private Type DEVMODE
        dmDeviceName As String * CCDEVICENAME
        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 As String * CCFORMNAME
        dmUnusedPadding As Integer
        dmBitsPerPel As Integer
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
        dmICMMethod As Long 'NT 4.0
        dmICMIntent As Long 'NT 4.0
        dmMediaType As Long 'NT 4.0
        dmDitherType As Long 'NT 4.0
        dmReserved1 As Long 'NT 4.0
        dmReserved2 As Long 'NT 4.0
        dmPanningWidth As Long 'Win2000
        dmPanningHeight As Long 'Win2000
    End Type
    Private Declare Function EnumDisplayDevices Lib "user32" Alias "EnumDisplayDevicesA" (Unused As Any, ByVal iDevNum As Long, lpDisplayDevice As DISPLAY_DEVICE, ByVal dwFlags As Long) As Boolean
    Dim OldX As Long, OldY As Long, T As Long
    Private Sub Form_Load()
        'KPD-Team 2000
        DD.cb = Len(DD)
        OldX = Screen.Width / Screen.TwipsPerPixelX
        OldY = Screen.Height / Screen.TwipsPerPixelY
        'First retieve some display info
        If EnumDisplayDevices(ByVal 0&, 0, DD, ByVal 0&) Then
            'and show it
            Me.AutoRedraw = True
            Me.Print "Device String:" + Left$(DD.DeviceString, InStr(1, DD.DeviceString, Chr$(0)) - 1)
            Me.Print "Device Name:" + Left$(DD.DeviceName, InStr(1, DD.DeviceName, Chr$(0)) - 1)
            Me.Print "Device Key:" + Left$(DD.DeviceKey, InStr(1, DD.DeviceKey, Chr$(0)) - 1)
            Me.Print "Device ID:" + Left$(DD.DeviceID, InStr(1, DD.DeviceID, Chr$(0)) - 1)
            Me.Print "Error while retrieving Display Information"
        End If
      '  DevM.dmSize = Len(DevM)
        'we want to change the horizontal and the vertical resolution
     '   DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    '    DevM.dmPelsWidth = 640
    '    DevM.dmPelsHeight = 480
    '    'change the display settings
    '    'Call ChangeDisplaySettingsEx(ByVal 0&, DevM, ByVal 0&, CDS_TEST, ByVal 0&)
    '    T = Timer
    '    Do: DoEvents: Loop Until Timer > T + 5
    '    DevM.dmPelsWidth = OldX
    '    DevM.dmPelsHeight = OldY
    '    'change the display settings back to the old settings
    '    Call ChangeDisplaySettingsEx(ByVal 0&, DevM, ByVal 0&, CDS_TEST, ByVal 0&)
    End Sub

    Open in new window

    LVL 5

    Author Comment

    I took out just the part that I needed, which would be the declarations and this code...

        DD.cb = Len(DD)
        If EnumDisplayDevices(ByVal 0&, 0, DD, ByVal 0&) Then
            'and show it
            MsgBox Left$(DD.DeviceString, InStr(1, DD.DeviceString, Chr$(0)) - 1)
            MsgBox "failed"
        End If

    Open in new window

    This did work on my PC, but on the PC with the display adapter I'm looking to find, it fails saying "Path not found".

    Any ideas?
    LVL 5

    Author Comment

    Ok, this seems to work...

    Sub Main()
    On Error Resume Next
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery _
        ("Select * from Win32_DisplayConfiguration")
    For Each objItem In colItems
         MsgBox "Device Name: " & objItem.DeviceName
    End Sub

    Open in new window

    LVL 5

    Author Comment

    I tried to give MartinLiss all the points and mark my last post as the best solution, but that didn't seem to work.

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Do email signature updates give you a headache?

    Do you feel like all of your time is spent managing email signatures? Too busy to visit every user’s desk to make updates? Want high-quality HTML signatures on all devices, including on mobiles and Macs? Then, let Exclaimer solve all your email signature problems today!

    Set OWA language and time zone in Exchange for individuals, all users or per database.
    ADCs have gained traction within the last decade, largely due to increased demand for legacy load balancing appliances to handle more advanced application delivery requirements and improve application performance.
    To show how to create a transport rule in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Mail Flow >> Rules tab.:  To cr…
    To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    9 Experts available now in Live!

    Get 1:1 Help Now