vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Blitzschnelles Erstellen von grafischen Diagrammen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: System/Windows · Desktop/Bildschirm/Display   |   VB-Versionen: VB4, VB5, VB614.11.06
Ermitteln der aktuellen Farbpalette (Farbtiefe)

Dieser Tipp zeigt, wie man die aktuell im System eingestellte Farbpalette (Farbtiefe) ermittelt.

Autor:   Microsys KramerBewertung:     [ Jetzt bewerten ]Views:  7.180 
www.access-paradies.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Mit nachfolgendem Code lässt sich ermitteln, welche Farbpalette (Farbtiefe) im System aktuell eingestellt ist.

Fügen Sie den Code am besten in ein Modul:

Option Explicit
 
' Benötigte API-Deklarationen 
Private Declare Function api_GetDeviceCaps Lib "gdi32" _
  Alias "GetDeviceCaps" ( _
  ByVal hdc As Long, _
  ByVal nIndex As Long) As Long
 
Private Declare Function api_CreateIC Lib "gdi32" _
  Alias "CreateICA" ( _
  ByVal lpDriverName As String, _
  ByVal lpDeviceName As Any, _
  ByVal lpOutput As Any, _
  ByVal lpInitData As Any) As Long
 
Private Declare Function api_DeleteDC Lib "gdi32" _
  Alias "DeleteDC" ( _
  ByVal hdc As Long) As Long
' // -----------------------------------------------------------------
' // Funktion:  | Farbpalette_ermitteln
' // -----------------------------------------------------------------
' // Methode:   | Ermittelt die aktuelle Farbpalette
' // -----------------------------------------------------------------
Public Function Farbpalette_ermitteln() As String
  On Error GoTo Err_Farbpalette_ermitteln
 
  Dim Planes  As Integer
  Dim Bits    As Integer
 
  Planes = Getdevcaps(14)
  Bits = Getdevcaps(12)
 
  If Planes = 1 Then
    Select Case Bits
      Case 8
        Farbpalette_ermitteln = "256 Farben"
      Case 15
        Farbpalette_ermitteln = "32768 Farben"
      Case 16
        Farbpalette_ermitteln = "65536  Farben" ' "High Color (16 Bit)"
      Case 24
        Farbpalette_ermitteln = "16777216 Farben"
      Case 32
        Farbpalette_ermitteln = "True Color (32 Bit)"
    End Select
  ElseIf Planes = 4 Then
    Farbpalette_ermitteln = "16 Farben"
  Else
    Farbpalette_ermitteln = "Unbekannt"
  End If
 
Exit_Farbpalette_ermitteln:
  Exit Function
 
Err_Farbpalette_ermitteln:
  Farbpalette_ermitteln = "Unbekannt"
  Resume Exit_Farbpalette_ermitteln
End Function
Public Function Getdevcaps%(ByVal intCapability As Integer)
  On Error GoTo Err_Getdevcaps
 
  Dim hdc As Long
 
  Const DRIVER_NAME = "DISPLAY"
  Const DEVICE_NAME = 0&
  Const OUTPUT_DEVICE = 0&
  Const LPDEVMODE = 0&
 
  hdc = api_CreateIC(DRIVER_NAME, DEVICE_NAME, OUTPUT_DEVICE, LPDEVMODE)
  If hdc Then
    Getdevcaps = api_GetDeviceCaps(hdc, intCapability)
    hdc = api_DeleteDC(hdc)
  End If
 
Exit_Getdevcaps:
  Exit Function
 
Err_Getdevcaps:
  Getdevcaps = ""
  Resume Exit_Getdevcaps
End Function

Dieser Tipp wurde bereits 7.180 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-2019 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