home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form Form1
- BorderStyle = 3 'Fixed Dialog
- Caption = "Screen Resolution"
- ClientHeight = 525
- ClientLeft = 2475
- ClientTop = 3015
- ClientWidth = 4170
- Height = 930
- Left = 2415
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 525
- ScaleWidth = 4170
- ShowInTaskbar = 0 'False
- Top = 2670
- Width = 4290
- Begin VB.Label Label2
- Caption = "Label2"
- Height = 255
- Left = 2040
- TabIndex = 1
- Top = 120
- Width = 1935
- End
- Begin VB.Label Label1
- Caption = "Your screen resolution is"
- Height = 255
- Left = 120
- TabIndex = 0
- Top = 120
- Width = 1815
- End
- Attribute VB_Name = "Form1"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- 'API Declares.
- '*************************************************
- 'Gets window handle for Desktop window.
- Private Declare Function GetDesktopWindow Lib "User32" () As Long
- 'Retrieve device context.
- Private Declare Function GetDC Lib "User32" (ByVal hwnd As Long) As Long
- 'Get device capabilities.
- Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
- 'Release device context.
- Private Declare Function ReleaseDC Lib "User32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
- Public Sub DesktopHandle()
- Dim hdesktopwnd
- 'Get handle to Desktop.
- hdesktopwnd = GetDesktopWindow()
- End Sub
- Public Sub DeviceInfo()
- Dim DisplayBits
- Dim DisplayPlanes
- Dim DisplayWidth
- Dim DisplayHeight
- Dim RetVal
- 'Get display context for desktop.
- hdccaps = GetDC(hdesktopwnd)
- 'Bits per pixel.
- DisplayBits = GetDeviceCaps(hdccaps, 12)
- 'Bitplanes.
- DisplayPlanes = GetDeviceCaps(hdccaps, 14)
- 'Horz. Resolution.
- DisplayWidth = GetDeviceCaps(hdccaps, 8)
- 'Vert. Resolution.
- DisplayHeight = GetDeviceCaps(hdccaps, 10)
- 'Release display context.
- RetVal = ReleaseDC(hdesktopwnd, hdccaps)
- 'To determine colors:
- If DisplayBits = 1 Then
- If DisplayPlanes = 1 Then
- 'Running in 1-bit, 2 color mode.
- Label2 = "1-bit/2 colours"
- ElseIf DisplayPlanes = 4 Then
- 'Running in 4-bit, 16 color mode.
- Label2 = "4-bit/16 colur mode"
- End If
- ElseIf DisplayBits = 8 Then
- 'Running in 8-bit, 256 color mode.
- Label2 = "8 bit/256 colours"
- ElseIf DisplayBits = 16 Then
- 'Running in 16-bit, 65000 color mode.
- Label2 = "16 bit/65,000 colours"
- 'Running in custom color mode (16million).
- Label2 = "Hmmmm...could be 16,000,000 colurs, or Custom Mode"
- End If
- End Sub
- Private Sub Form_Load()
- Call DeviceInfo
- End Sub
-