vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2020
 
zurück
Rubrik: System/Windows · Sonstiges   |   VB-Versionen: VB5, VB605.08.03
Installierte Grafik- und Soundkarten

In Verbindung mit DirectX lässt sich schnell ermitteln, welche Grafikkarten und Soundkarten verügbar sind.

Autor:   Michael FuhrerBewertung:     [ Jetzt bewerten ]Views:  10.687 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Mit dem nachfolgendem Code ist es möglich, die Grafikkarten (inkl. Auflösungen) und die Soundkarten aufzulisten, die auf dem Computer installiert sind.

Hierzu müssen Sie DirectX7 einbinden: Projekt/Verweise - DirectX for Visual Basic Type Library

Den nachfolgenden Code in ein Modul kopieren:

Option Explicit
 
Public DX7 As DirectX7
Public DDraw As DirectDraw7
 
Private Type AuflösungType
  Count As Long       ' Anzahl der GrafikModis
  Width As Long       ' maximal mögliche Breite
  Hight As Long       ' maximal mögliche Höhe
  ColorDepth As Long  ' maximale Farbtiefe
End Type
 
Private Type DDDeviceType
  DeviceCount As Integer
  DeviceDesc As String        ' Hardware Beschreibung
  DeviceGuid As String        ' Hardware GUID
  DeviceName As String        ' Hardware Name
 
  ' Speichert die Auflösungen
  GrafikAuflösung() As AuflösungType
End Type
 
Public Enum DeviceError
  Grafikkarte = 1
  Soundkarte = 2
  Alle = 3
End Enum
 
Public GrafikDevice() As DDDeviceType
Public SoundDevice() As DDDeviceType
 
Public isError As DeviceError
' vorhandene Hardware in ein Array speichern
Public Function Get_DeviceEnum() As DeviceError
  Dim DDEnum As DirectDrawEnum
  Dim DSEnum As DirectSoundEnum
  Dim i As Integer
 
  On Error GoTo ErrHandler
  Set DX7 = New DirectX7
  Set DDEnum = DX7.GetDDEnum
  If DDEnum.GetCount > 0 Then
    ' Array-Größe festlegen
    ReDim GrafikDevice(DDEnum.GetCount) As DDDeviceType
    GrafikDevice(1).DeviceCount = DDEnum.GetCount
    For i = 1 To GrafikDevice(1).DeviceCount
      ' Grafikkarten Infos werden gespeichert
      With GrafikDevice(i - 1)
        .DeviceGuid = DDEnum.GetGuid(i)
        .DeviceDesc = DDEnum.GetDescription(i)
        .DeviceName = DDEnum.GetName(i)
 
        ' Auflösungen in 2tem Array auflisten
        Get_DDDisplayEnum i - 1
      End With
    Next i
  End If
 
  Set DSEnum = DX7.GetDSEnum
  If DSEnum.GetCount > 0 Then
    ReDim SoundDevice(DSEnum.GetCount) As DDDeviceType
    SoundDevice(1).DeviceCount = DSEnum.GetCount
    For i = 1 To SoundDevice(1).DeviceCount
      ' Soundkarten Infos werden gespeichert
      With SoundDevice(i - 1)
        .DeviceGuid = DSEnum.GetGuid(i)
        .DeviceDesc = DSEnum.GetDescription(i)
        .DeviceName = DSEnum.GetName(i)
      End With
    Next i
  End If
 
ErrHandler:
  ' Prüfen ob die Hardware vorhanden ist
  If DDEnum.GetCount <= 0 And DSEnum.GetCount <= 0 Then
    Get_DeviceEnum = Alle
    isError = Alle
  ElseIf DDEnum.GetCount <= 0 Then
    Get_DeviceEnum = Grafikkarte
    isError = Grafikkarte
  ElseIf DSEnum.GetCount <= 0 Then
    Get_DeviceEnum = Soundkarte
    isError = Soundkarte
  End If
 
  Set DX7 = Nothing
End Function
Private Sub Get_DDDisplayEnum(ByVal ArrayNr As Integer)
  Dim DDDisplayEnum As DirectDrawEnumModes
  Dim i As Integer
  Dim TmpSurfDesc As DDSURFACEDESC2
 
  On Error GoTo ErrHandler
 
  ' DirectDraw instanzieren, da die variable
  ' DDDsiplayEnum von DirectDraw instanziert
  ' werden muss
  Set DDraw = DX7.DirectDrawCreate( _
    GrafikDevice(ArrayNr).DeviceGuid)
  Set DDDisplayEnum = DDraw.GetDisplayModesEnum( _
    DDEDM_DEFAULT, TmpSurfDesc)
 
  If DDDisplayEnum.GetCount > 0 Then
    With GrafikDevice(ArrayNr)
      ReDim .GrafikAuflösung(DDDisplayEnum.GetCount) As AuflösungType
      .GrafikAuflösung(ArrayNr).Count = DDDisplayEnum.GetCount
      For i = 1 To .GrafikAuflösung(ArrayNr).Count
        DDDisplayEnum.GetItem i, TmpSurfDesc
 
        .GrafikAuflösung(i - 1).ColorDepth = _
          TmpSurfDesc.ddpfPixelFormat.lRGBBitCount
        .GrafikAuflösung(i - 1).Hight = _
          TmpSurfDesc.lHeight
        .GrafikAuflösung(i - 1).Width = _
          TmpSurfDesc.lWidth
      Next i
    End With
  End If
 
ErrHandler:
  Set DDraw = Nothing
End Sub

Fügen Sie der Form jetzt drei ComboBoxen hinzu (Combo1 - Combo3). Die einzelnen ComboBoxen werden dann im Form_Load Ereignis der Form1 mit den ermittelten Daten gefüllt.

Private Sub Form_Load()
  Dim DeviceError As DeviceError
 
  DeviceError = Show_Devices(Combo1, Combo2, Combo3)
  If DeviceError = Grafikkarte Then
    MsgBox "Keine Grafikkarte vorhanden."
  ElseIf DeviceError = Soundkarte Then
    MsgBox "Keine Soundkarte installiert."
  End If
End Sub
Private Function Show_Devices(cmbGrafik As ComboBox, _
  cmbAuflösung As ComboBox, _
  cmbSound As ComboBox) As DeviceError
 
  Dim i As Integer
  Dim i2 As Integer
 
  Show_Devices = Get_DeviceEnum
  If isError = Alle Then Exit Function
 
  If isError <> Grafikkarte Then
    For i = 0 To GrafikDevice(1).DeviceCount - 1
      With GrafikDevice(i)
        cmbGrafik.AddItem .DeviceDesc
        For i2 = 0 To .GrafikAuflösung(i).Count - 1
          With .GrafikAuflösung(i2)
            cmbAuflösung.AddItem .Width & " x " & _
              .Hight & " x " & .ColorDepth
          End With
        Next i2
      End With
    Next i
  End If
 
  If isError <> Soundkarte Then
    For i = 0 To SoundDevice(1).DeviceCount - 1
      cmbSound.AddItem SoundDevice(i).DeviceDesc
    Next i
  End If
End Function

Dieser Tipp wurde bereits 10.687 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2020 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel